=================================================================== RCS file: /cvs/openbsd/OpenBSDTorrents/CurrentTorrents.pl,v retrieving revision 1.11 retrieving revision 1.28 diff -u -r1.11 -r1.28 --- openbsd/OpenBSDTorrents/CurrentTorrents.pl 2005/04/07 00:04:40 1.11 +++ openbsd/OpenBSDTorrents/CurrentTorrents.pl 2010/01/05 19:55:22 1.28 @@ -1,107 +1,238 @@ #!/usr/bin/perl -T -#$Id: CurrentTorrents.pl,v 1.11 2005/04/06 23:04:40 andrew Exp $ +#$RedRiver: CurrentTorrents.pl,v 1.26 2009/10/20 19:04:28 andrew Exp $ use strict; use warnings; use diagnostics; -use BT::MetaInfo; use Time::Local; +use Fcntl ':flock'; +use File::Basename; +#use YAML; + use lib 'lib'; use OpenBSDTorrents; +use BT::MetaInfo::Cached; %ENV = (); -#use YAML; +#justme(); -justme(); +my $Name_Filter = shift || ''; +if ( $Name_Filter =~ /^(\w*)$/ ) { + $Name_Filter = $1; +} +else { + die "Invalid filter: $Name_Filter"; +} +my %Possible_Torrents; +Process_Dir( $OBT->{DIR_FTP} ); + my %files; -opendir DIR, $OBT->{DIR_TORRENT} - or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!"; -foreach (readdir DIR) { - if (/^([^\/]+)$/) { - $_ = $1; - } else { - die "Invalid character in $_: $!"; - } - next unless /\.torrent$/; - my ($name, $year, $mon, $mday, $hour, $min) = - /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; +my @delete; +foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) { + opendir DIR, $DIR + or die "Couldn't opendir $DIR: $!"; + foreach ( readdir DIR ) { + next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/; - $mon--; - my $epoch = timegm(0,$min,$hour,$mday,$mon,$year); + if (/^([^\/]+)$/) { + $_ = $1; + } + else { + die "Invalid character in $_: $!"; + } + my $epoch = 0; + my $name = basename( $_, '.torrent' ); - #print "Adding $_\n"; + if ( my ( $base, $year, $mon, $mday, $hour, $min ) + = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ ) + { - $files{$name}{$epoch} = { - file => $_, - year => $year, - mon => $mon, - mday => $mday, - hour => $hour, - min => $min, - epoch => $epoch, - }; + $mon--; + $epoch = timegm( 0, $min, $hour, $mday, $mon, $year ); + $name = $base; + } + #print "Adding $_\n"; + + $files{$ext}{$name}{$epoch} = { + file => $_, + dir => $DIR, + path => "$DIR/$_", + ext => $ext, + + #year => $year, + #mon => $mon, + #mday => $mday, + #hour => $hour, + #min => $min, + name => $name, + epoch => $epoch, + }; + + if ( $name =~ m/\A $OBT->{BASENAME} /xms + && !exists $Possible_Torrents{$name} ) + { + print "Would remove $_\n"; + push @delete, $files{$ext}{$name}{$epoch}; + } + } + closedir DIR; } -closedir DIR; +#print Dump \%files; + my %keep; -my @delete; -foreach my $name (keys %files) { - #print "$name\n"; +foreach my $name ( sort keys %{ $files{torrent} } ) { + next unless $name =~ /^$Name_Filter/; - foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) { - #print "\t$epoch\n"; - my $torrent = $files{$name}{$epoch}{file}; + #print "Checking $name\n"; - my $t; - eval { $t = BT::MetaInfo->new($OBT->{DIR_TORRENT} . "/$torrent"); }; - if ($@) { - warn "Error reading torrent $torrent\n"; - next; - } + foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) + { - $files{$name}{$epoch}{comment} = $t->{comment}; - my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s; + #print "\t$epoch\n"; + my $torrent = $files{torrent}{$name}{$epoch}{path}; - unless (-d $OBT->{DIR_FTP} . "/$path") { - #print "Deleting $files{$name}{$epoch}{file} the path doesn't exist.\n"; - push @delete, $files{$name}{$epoch}{file}; - } + if ( keys %{ $files{torrent}{$name} } == 1 + && $files{torrent}{$name}{$epoch}{dir} eq $OBT->{DIR_TORRENT} ) + { - if (keys %{ $files{$name} } == 1) { - #print "Skipping torrent for $name there is only one.\n"; - next; - } + #print "Skipping torrent for $name there is only one.\n"; + next; + } - my $hash = $t->info_hash; - $hash = unpack("H*", $hash); + my $t; + eval { + $t = BT::MetaInfo::Cached->new( + $torrent, + { cache_root => '/tmp/OBTFileCache' - $files{$name}{$epoch}{info_hash} = $hash; + #$OBT->{DIR_HOME} . '/FileCache' + } + ); + }; - undef $t; + if ($@) { + warn "Error reading torrent $torrent\n"; + push @delete, $files{torrent}{$name}{$epoch}; + delete $files{torrent}{$name}{$epoch}; + next; + } - if (exists $keep{$name}) { - if (exists $keep{$name}{$hash}) { - push @delete, $keep{$name}{$hash}; - $keep{$name}{$hash} = - $files{$name}{$epoch}{file}; - } else { - push @delete, $files{$name}{$epoch}{file}; - } - } else { - $keep{$name}{$hash} = - $files{$name}{$epoch}{file}; + $files{torrent}{$name}{$epoch}{comment} = $t->{comment}; + my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s; - } - } + unless ( -e $OBT->{DIR_FTP} . "/$path" ) { + print + "Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n"; + push @delete, $files{torrent}{$name}{$epoch}; + delete $files{torrent}{$name}{$epoch}; + next; + } + + my $hash = $t->info_hash; + $hash = unpack( "H*", $hash ); + + undef $t; + + $files{torrent}{$name}{$epoch}{info_hash} = $hash; + + if ( exists $keep{$hash} ) { + if ( $keep{$hash}{epoch} == $epoch ) { + next; + } + print "Removing [$name] [$hash]\n\t", $keep{$hash}{path}, "\n"; + push @delete, $keep{$hash}; + delete $files{torrent}{ $keep{$hash}{name} } + { $keep{$hash}{epoch} }; + $keep{$hash} = $files{torrent}{$name}{$epoch}; + print "Keeping additional instance of [$name] [$hash]\n\t", + $keep{$hash}{path}, + "\n"; + } + else { + print "Removing old [$name] [$hash]\n"; + if ( $keep{$hash}{path} ) { + print "\t", $keep{$hash}{path}, "\n"; + } + push @delete, $files{torrent}{$name}{$epoch}; + delete $files{torrent}{$name}{$epoch}; + } + else { + print "Keeping first instance of $name [$hash]\n\t", + $files{torrent}{$name}{$epoch}{path}, + "\n"; + $keep{$hash} = $files{torrent}{$name}{$epoch}; + + } + } } #print Dump \%files, \%keep, \@delete; +#exit; foreach (@delete) { - print "Deleting '$_'\n"; - unlink $OBT->{DIR_TORRENT} . "/$_" or die "Couldn't unlink $_"; + print "Deleting '$_->{path}'\n"; + unlink $_->{path} or die "Couldn't unlink $_->{path}"; } + +foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) { + foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) { + unless ( exists $files{torrent}{$name}{$epoch} ) { + my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path}; + print "Unlinking '$path'\n"; + unlink $path or die "couldn't unlink '$path': $!"; + } + } +} + +#print Dump \%keep; +foreach my $hash ( keys %keep ) { + my $file = $keep{$hash}{file} || q{}; + my $dir = $keep{$hash}{dir} || q{}; + if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) { + print "Moving $file to current torrents\n"; + rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file ) + or die "Couldn't rename '$file': $!"; + + my $name = $keep{$hash}{name}; + my $epoch = $keep{$hash}{epoch}; + + if ( exists $files{txt}{$name}{$epoch} ) { + my $m_file = $files{txt}{$name}{$epoch}{file}; + my $m_dir = $files{txt}{$name}{$epoch}{dir}; + rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file ) + or die "Couldn't rename '$m_file': $!"; + } + } +} + +sub Process_Dir { + my $basedir = shift; + + my ( $dirs, $files ) = Get_Files_and_Dirs($basedir); + if (@$files) { + my $dir = $basedir; + $dir =~ s/^$OBT->{DIR_FTP}\///; + my $torrent = Name_Torrent($dir); + $torrent =~ s/-.*$//; + $Possible_Torrents{$torrent} = 1; + foreach my $file (@$files) { + if ( $file =~ /$INSTALL_ISO_REGEX/ ) { + $torrent = Name_Torrent("$dir/$file"); + $torrent =~ s/-.*$//; + $Possible_Torrents{$torrent} = 1; + } + } + } + + foreach my $subdir (@$dirs) { + next if $subdir eq '.'; + next if $subdir eq '..'; + Process_Dir("$basedir/$subdir"); + } +} +