download ST:TNG previews from startrek.com

tng-previews.pl

#!/usr/bin/env perl
use warnings;
use strict;
use LWP::Simple;
$|=1;

my $root = 'http://www.startrek.com/videos/star-trek-the-next-generation/all/preview/episode';
my $content = get($root);
$content =~ s/M.nage . Troi/Menage a Troi/;
my $l = qr{
	<a\ href="/watch_video/[^">]+">
	<img\ src="/legacy_media/images(/200306/tng-\d+/)120x90.jpg"\ />
	</a>\s*
	<h4><a\ href="[^"]+">Episode\ Preview:\ ([^<>]+)</a></h4>\s*
	<p>Season\ (\d)\s+Ep.\s+(\d+)</p>
}msix;
my @l = $content =~ /$l/g;

while (@l) {
	my $u = shift @l;
	my $n = shift @l;
	my $s = shift @l;
	my $e = shift @l;
	$u = 'http://www.startrek.com/legacy_media/videos'.$u.'300k.flv';

	$n =~ s/[^',. A-Za-z0-9]/_/g;

	my $fname = sprintf('S%dE%02d - %s.flv',$s,$e,$n);

	next if -e $fname;
	print localtime()." $fname\n";
	my $data = get($u);
	open(my $out, '>', $fname) or die "$!";
	binmode($out);
	print $out $data;
	close($out);
}