[BACK]Return to CurrentTorrents.pl CVS log [TXT][DIR] Up to [local] / openbsd / OpenBSDTorrents

Diff for /openbsd/OpenBSDTorrents/CurrentTorrents.pl between version 1.1 and 1.27

version 1.1, 2005/03/23 00:15:55 version 1.27, 2010/01/05 19:43:44
Line 1 
Line 1 
 #!/usr/bin/perl -T  #!/usr/bin/perl -T
 #$Id$  #$RedRiver: CurrentTorrents.pl,v 1.26 2009/10/20 19:04:28 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use diagnostics;  use diagnostics;
   
 use BT::MetaInfo;  use Time::Local;
   use Fcntl ':flock';
   use File::Basename;
   
   #use YAML;
   
 use lib 'lib';  use lib 'lib';
 use OpenBSDTorrents;  use OpenBSDTorrents;
   use BT::MetaInfo::Cached;
   
 %ENV = ();  %ENV = ();
   
 use YAML;  #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;
   my %keep;
   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})$/;
   
           if (/^([^\/]+)$/) {
               $_ = $1;
           }
           else {
               die "Invalid character in $_: $!";
           }
           my $epoch = 0;
           my $name = basename( $_, '.torrent' );
   
           if ( my ( $base, $year, $mon, $mday, $hour, $min )
               = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
           {
   
               $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;
   }
   
   #print Dump \%files;
   foreach my $name ( sort keys %{ $files{torrent} } ) {
       next unless $name =~ /^$Name_Filter/;
   
       #print "Checking $name\n";
   
       foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } )
       {
   
           #print "\t$epoch\n";
           my $torrent = $files{torrent}{$name}{$epoch}{path};
   
           if ( keys %{ $files{torrent}{$name} } == 1
               && $files{torrent}{$name}{$epoch}{dir} eq $OBT->{DIR_TORRENT} )
           {
   
               #print "Skipping torrent for $name there is only one.\n";
               next;
           }
   
           my $t;
           eval {
               $t = BT::MetaInfo::Cached->new(
                   $torrent,
                   {   cache_root => '/tmp/OBTFileCache'
   
                           #$OBT->{DIR_HOME} . '/FileCache'
                   }
               );
           };
   
           if ($@) {
               warn "Error reading torrent $torrent\n";
               push @delete, $files{torrent}{$name}{$epoch};
               delete $files{torrent}{$name}{$epoch};
               next;
           }
   
           $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{$name} ) {
               if ( exists $keep{$name}{$hash} ) {
                   if ( $keep{$name}{$hash}{epoch} == $epoch ) {
                       next;
                   }
                   print "Removing [$name] [$hash]\n\t",
                       $keep{$name}{$hash}{path},
                       "\n";
                   push @delete, $keep{$name}{$hash};
                   delete $files{torrent}{ $keep{$name}{$hash}{name} }
                       { $keep{$name}{$hash}{epoch} };
                   $keep{$name}{$hash} = $files{torrent}{$name}{$epoch};
                   print "Keeping additional instance of  [$name] [$hash]\n\t",
                       $keep{$name}{$hash}{path},
                       "\n";
               }
               else {
                   print "Removing old [$name] [$hash]\n";
                   if ( $keep{$name}{$hash}{path} ) {
                       print "\t", $keep{$name}{$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{$name}{$hash} = $files{torrent}{$name}{$epoch};
   
           }
       }
   }
   
   #print Dump \%files, \%keep, \@delete;
   #exit;
   
   foreach (@delete) {
       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 $name ( keys %keep ) {
       foreach my $hash ( keys %{ $keep{$name} } ) {
           my $file = $keep{$name}{$hash}{file} || q{};
           my $dir  = $keep{$name}{$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{$name}{$hash}{name};
               my $epoch = $keep{$name}{$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");
       }
   }
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.27
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>