The Code

Save the following code to a file named m3ugen.pl somewhere on your PC or Mac's hard drive:

	#!c:\perl\bin\perl.exe
	use strict;
	use HTML::LinkExtor;
	use LWP::Simple;
	use URI::URL;
	use constant PROVIDER => qq{http://www.shoutcast.com/};
	use constant DIRECTORY => PROVIDER.qq{directory/};

	my $genre=$ARGV[0];
	my $results=$ARGV[1];
	my $outfile=$ARGV[2];
	unless (defined($genre) &&
		defined($results) && $results && $results <= 25 &&
		defined($outfile)) {
	  die qq{Usage:\t$0 [genre] [numresults] [outfile]\n}.
		qq{\tgenre=TopTen,House,Blues,Punk,...\n}.
		qq{\tnumresults=1..25\n}.
		qq{\toutfile=m3u output file\n};
	}
	my @playlists=getPlaylists(DIRECTORY.
	qq{?sgenre=$genre&numresult=$results},PROVIDER); 
	unless (scalar(@playlists)) {
	  die "No results found - unable to create playlist\n";
	  exit(0); 
	} 
	@playlists=mapForTiVo(@playlists);

	open(OUT,">".$outfile) or die "Unable to create output file - $!"; 
	print OUT qq{#EXTM3U\n};

	foreach my $entry (@playlists) { 
      my($url,$title)=%$entry; 
	  print OUT qq{#EXTINF:,$title\n$url\n};
	} 
	close(OUT);

	sub getPlaylists { 
	  my($url,$base)=@_; 
	  my(@results); 
	  my $content=get($url);

	  unless (defined($content) && length($content)) {
		warn qq{Unable to fetch "$url"\n};
		return @results;
	  }
	  my $parser=HTML::LinkExtor->new(sub {
	    my($t,%a)=@_;
		return if $t ne 'a';
		push(@results,$a{href}) if($a{href}=~/filename\.pls$/i);
	  });

	  $parser->parse($content);
	  @results = map {$_=url($_,$base)->abs;} @results;
	  return @results;
	}

   	 sub mapForTiVo { 
	  my(@list)=@_; 
	  my(@results);

	  foreach my $url (@list) {
	    my $content=get($url);
		next unless(defined($content) && length($content));

		my($file);
		foreach my $line (split(/[\n\r]/,$content)) {
		  if ($line =~ /^File\d+=(.*)$/i) { 
		    my $u=URI::URL->new($1); 
			$u->path(""),$file=$u->abs if($u->path eq '/' || $u->path eq '');
		  } elsif ($line =~ /^Title\d+\s*=(.*)$/i && defined($file)) { 
			push(@results,{$file => $1}); 
			last;
}
		}
	  }
	  return @results;
	}

Mac OS X and Unix/Linux users should alter the first line to point to the proper location of Perl:

	#!/usr/bin/perl