Doctor Who Collection

#!/usr/bin/perl -w # # Build the web interface for access to Doctor Who episodes I've # accumulated... # # Working on this - want to output new table and header when the doctor # changes as well as a button and description info for that doctor. # Probably should special case the doctors revisited episodes to put # them first for each doctor (Perhaps add a special sortdate attribute # to override airdate for sort, but not for print). use strict; use Data::Dumper; # Get PATH set to include this script's directory and other useful bits my $newpath=`dirname $0`; chomp($newpath); $newpath=`$newpath/echo-path`; chomp($newpath); $ENV{'PATH'}=$newpath; my $verbose = (scalar(@ARGV) == 1) && ($ARGV[0] eq "-v"); # Update the database file with latest information system("build-db"); my $topdir="/huge/vids"; my $whodir="$topdir/DoctorWho"; my $dbdir="$whodir/.data"; my $dbfile="$dbdir/allinfo.txt"; my $doctorfile="$dbdir/doctors.txt"; my $webindex="$whodir/index.html"; my %db; my %doctors; # Now read in the database of all the episode information my $fh; my $r; if (open($fh, '<', $dbfile)) { while (<$fh>) { chomp; if (/^\[(.+)\]$/) { my $basename = $1; $r = {}; $db{$basename} = $r; } elsif (/^([A-Za-z0-9_]+)=(.+)$/) { if (defined($r)) { my $key = $1; my $val = $2; $r->{$key} = $val; } } } close($fh); undef($fh); undef($r); } # And all the doctor information if (open($fh, '<', $doctorfile)) { while (<$fh>) { chomp; if (/^\[(.+)\]$/) { my $docname = $1; $r = {}; $doctors{$docname} = $r; } elsif (/^([A-Za-z0-9_]+)=(.+)$/) { if (defined($r)) { my $key = $1; my $val = $2; $r->{$key} = $val; } } } close($fh); undef($fh); undef($r); } # Build the index.html file from the information in the database my $tempfile="$webindex.$$"; my $htm; open($htm, '>', $tempfile) || die "Cannot write $tempfile : $!\n"; print $htm <<'HEADER'; Doctor Who Collection

HEADER my $lastdoc; sub compare_airdate { my $ada = $db{$a}->{'sortdate'}; my $adb = $db{$b}->{'sortdate'}; if (! defined($ada)) { $ada=$db{$a}->{'airdate'} } if (! defined($adb)) { $adb=$db{$b}->{'airdate'}; } if (! defined($ada)) { $ada=''; } if (! defined($adb)) { $adb=''; } return $ada cmp $adb; } my @doclist; my $n; foreach $n (sort compare_airdate keys %db) { my $r = $db{$n}; my $doc = $r->{'doctor'}; my $avi = $r->{'avi'}; my $mpg = $r->{'mpg'}; next if (! $avi) && (! $mpg); my $nth = 0; if (defined($doc)) { $doc = $doctors{$doc}; if (defined($doc)) { my $num = $doc->{'index'}; if (defined($num)) { $nth = $num+0; } } } if (! defined($doclist[$nth])) { $doclist[$nth] = []; } push(@{$doclist[$nth]}, $n); } my $showcount=0; my $showsec=0.0; my $doc; my $butnum = 0; foreach $doc (@doclist) { my $d = $db{$doc->[0]}; $d = $d->{'doctor'}; print $htm "

"; if (! defined($d)) { print $htm "General Wibbly-Wobbly, Timey-Wimey, Spacey-Wacey stuff..

\n"; print $htm "

\n"; } else { my $dr = $doctors{$d}; my $di = $dr->{'image'}; my $dw = $dr->{'which'}; print $htm "$d: The $dw Doctor.

\n"; print $htm "

"; my $companions=$dr->{'companions'}; if (defined($companions)) { my $cp; foreach $cp (split(/,/,$companions)) { print $htm "\ "; } } print $htm "

\n"; } print $htm " \n"; ++$butnum; print $htm <<'FIRSTROW'; FIRSTROW foreach $n (@{$doc}) { my $r = $db{$n}; my $avi = $r->{'avi'}; my $mpg = $r->{'mpg'}; next if (! $avi) && (! $mpg); my $handtuned=0; if (exists($r->{'handtuned'}) && ($r->{'handtuned'} == 1)) { $handtuned=1; } my $torrent=0; if (exists($r->{'torrent'}) && ($r->{'torrent'} ne '')) { $torrent=1; } my $warning = 0; if (! $avi) { $warning = 1; print STDERR "$n: Missing .avi file\n" if $verbose && (! $handtuned); } if (! $mpg) { $warning = 1; print STDERR "$n: Missing .mpg file\n" if $verbose && (! $handtuned); } my $airdate = $r->{'airdate'}; my $minutes = $r->{'aviseconds'}; if (defined($minutes)) { $showsec += $minutes; $minutes = int(($minutes + 30.0)/60.0); if ($minutes < 41) { $warning = 1; print STDERR "$n: AVI duration less than 41 minutes\n" if $verbose && (! $handtuned); } } else { $minutes = ''; $warning = 1; print STDERR "$n: No AVI duration available\n" if $verbose && (! $handtuned); } my $edl = $r->{'edl'}; if ((! defined($edl)) || ($edl eq 'bad')) { my $mpgdirname = $r->{'mpgdirname'}; if ((! defined($mpgdirname)) || (! (-f "$whodir/$mpgdirname/$n.keep"))) { $warning = 1; print STDERR "$n: No or bad .edl file\n" if $verbose && (! $handtuned); } } if ($minutes ne '') { my $mpgminutes = $r->{'mpgseconds'}; if (defined($mpgminutes)) { $mpgminutes = int(($mpgminutes + 30.0)/60.0); if ($mpgminutes < 62) { $warning = 1; print STDERR "$n: MPG less than 62 minutes\n" if $verbose && (! $handtuned); } $minutes .= " was $mpgminutes"; } else { $warning = 1; print STDERR "$n: No MPG duration available\n" if $verbose && (! $handtuned); } } my $avisize = $r->{'avisize'}; if (defined($avisize)) { $avisize = int(($avisize + (500*1000))/(1000*1000)); $avisize = "$avisize MB"; } else { $warning = 1; $avisize = ''; print STDERR "$n: No AVI size available\n" if $verbose && (! $handtuned); } my $flag_new = 0; my $flag_very_new = 0; my $readme=''; if ($mpg) { my $mpgdirname = $r->{'mpgdirname'}; if (defined($mpgdirname)) { if (-f "$whodir/$mpgdirname/README") { $readme="$mpgdirname/README"; } my $mpgfile = "$whodir/$mpgdirname/$n.mpg"; if ((-f $mpgfile) && ((-M $mpgfile) < 7)) { if ((-M $mpgfile) < 1) { $flag_very_new = 1; } else { $flag_new = 1; } } # If there is a "guess" .keep file check out the durations of the # keepable segments. If any but last one is less than 4 minutes or # greater than 20 minutes then that is highly suspicious. Come to # think of it, if there are more than 8 segments or less than 4, # that is kinda suspicious as well. my $guesskeep = "$whodir/$mpgdirname/guess-$n.guess"; my $gh; if (open($gh, '<', $guesskeep)) { my @durations; while (<$gh>) { chomp; my @set = split(' ', $_); if (scalar(@set) == 2) { push(@durations, $set[1] - $set[0]); } else { $warning = 1; print STDERR "$n: Bad format .keep line\n" if $verbose && (! $handtuned); } } close($gh); if ((scalar(@durations) < 4) || (scalar(@durations) > 8)) { $warning = 1; print STDERR "$n: Unlikely number of keep segs\n" if $verbose && (! $handtuned); } while (scalar(@durations) > 0) { my $dur = shift(@durations); if ($dur > (20.0*60)) { $warning = 1; print STDERR "$n: Segment time > 20 minutes\n" if $verbose && (! $handtuned); } if ((scalar(@durations) > 0) && ($dur < (4.0*60))) { $warning = 1; print STDERR "$n: Segment time < 4 minutes\n" if $verbose && (! $handtuned); } } } } } my $description = $r->{'description'}; if (! defined($description)) { print STDERR "No description for $n\n"; $description=''; } if ($avi) { my @pieces=split(/\"\;/, $description); if (scalar(@pieces) == 3) { my $mpgdirname = $r->{'mpgdirname'}; my $html5=''; my $vidsrc=''; if (-f "$whodir/$mpgdirname/$n.mp4") { if (! (-f "$whodir/$mpgdirname/$n.jpg")) { system("cd $whodir/$mpgdirname ; " . "make-poster $n.mp4 $n.jpg > /dev/null 2>\&1"); } $vidsrc .= < MP4SRC } if ( -f "$whodir/$mpgdirname/$n.webm") { $vidsrc .= < WEBMSRC } unlink("$whodir/$mpgdirname/$n.html"); if ($vidsrc ne '') { chomp($vidsrc); my $htm; if (open($htm, '>', "$whodir/$mpgdirname/$n.html")) { print $htm < $pieces[1]

$pieces[1]
$pieces[2]

HTMEND close($htm); } } if (-f "$whodir/$mpgdirname/$n.html") { $html5 = " HTML5"; } $description=$pieces[0] . "" . $pieces[1] . "" . $html5 . $pieces[2]; if (!defined($description)) { print STDERR "Ill-formed description for $n\n"; } } } else { $description=~s/\"\;//g; } if ($minutes eq '') { $minutes = ' '; } if ($avisize eq '') { $avisize = ' '; } if ($handtuned) { $minutes = "$minutes"; $warning = 0; } if ($torrent) { $warning = 0; } if ($warning) { $warning = '

'; } else { $warning = ''; } if ($flag_new || $flag_very_new) { if ($flag_new) { $warning .= '

'; } else { $warning .= '

'; } } if (! defined($airdate)) { $airdate=' '; } my $notes=''; if ((! exists($r->{'nodownload'})) || ($r->{'nodownload'} ne '1')) { $notes = '

'; } if ((! $handtuned) && (! $torrent)) { $notes .= ' ' if ($notes ne ''); $notes .= '

'; } if ($warning ne '') { $notes .= ' ' if ($notes ne ''); $notes .= $warning; } if ($readme ne '') { $notes .= ' ' if ($notes ne ''); $notes .= "" . "

"; } if ((! exists($r->{'title'})) || (! exists($r->{'airdate'}))) { $notes .= ' ' if ($notes ne ''); $notes .= '

'; } my $flags = $r->{'flags'}; if (defined($flags)) { $notes .= ' ' if ($notes ne ''); $notes .= '

'; if ($flags eq "R") { $flags = "
Episode reconstructed with stills and audio."; } elsif ($flags eq "A") { $flags="
Episode reconstructed with animation."; } else { $flags = "
Unknown flag $flags"; } } else { $flags=''; } if ($notes eq '') { $notes=' '; } ++$showcount; print $htm "\n"; } print $htm <<'TRAILER';

Original Airdate	Minutes	Size	Flags	Description
$airdate	$minutes	$avisize	$notes	${description}${flags}

TRAILER } print $htm "

$showcount Episodes recorded"; if ($showsec > 0) { $showsec = int($showsec + 0.5); my $showmin = int($showsec / 60); $showsec -= ($showmin * 60); my $showhour = int($showmin / 60); $showmin -= ($showhour * 60); my $showday = int($showhour / 24); $showhour -= ($showday * 24); if ($showday > 0) { if ($showday == 1) { print $htm ", 1 day"; } else { print $htm ", $showday days"; } } if ($showhour > 0) { if ($showhour == 1) { print $htm ", 1 hour"; } else { print $htm ", $showhour hours"; } } if ($showmin > 0) { if ($showmin == 1) { print $htm ", 1 minute"; } else { print $htm ", $showmin minutes"; } } if ($showsec > 0) { if ($showsec == 1) { print $htm ", 1 second"; } else { print $htm ", $showsec seconds"; } } print $htm " of commercial free Doctor Who."; } print $htm "

\n"; print $htm "

Icon legend:

\n"; print $htm <<'LEGEND';

Flag	Description
	Problems detected with this video.
	New recording less than a week old.
	New recording less than 24 hours old.
	Video has glitch, would like to download a new copy.
	Commercial removal not yet hand tweaked in this video.
	Link to special notes on this video.
	Missing attributes in database entry.
	Reconstructed episode cobbled together.

LEGEND my $curtime=`date`; chomp($curtime); print $htm "Page last modified $curtime"; print $htm <<'TRAILER';

TRAILER close($htm); unlink($webindex); rename($tempfile,$webindex);