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

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

version 1.26, 2009/10/20 20:04:28 version 1.27, 2010/01/05 19:43:44
Line 1 
Line 1 
 #!/usr/bin/perl -T  #!/usr/bin/perl -T
 #$RedRiver: CurrentTorrents.pl,v 1.25 2008/11/14 18:18:31 andrew Exp $  #$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;
Line 7 
Line 7 
 use Time::Local;  use Time::Local;
 use Fcntl ':flock';  use Fcntl ':flock';
 use File::Basename;  use File::Basename;
   
 #use YAML;  #use YAML;
   
 use lib 'lib';  use lib 'lib';
Line 18 
Line 19 
 #justme();  #justme();
   
 my $Name_Filter = shift || '';  my $Name_Filter = shift || '';
 if ($Name_Filter =~ /^(\w*)$/) {  if ( $Name_Filter =~ /^(\w*)$/ ) {
         $Name_Filter = $1;      $Name_Filter = $1;
 } else {  
         die "Invalid filter: $Name_Filter";  
 }  }
   else {
       die "Invalid filter: $Name_Filter";
   }
   
 my %Possible_Torrents;  my %Possible_Torrents;
 Process_Dir($OBT->{DIR_FTP});  Process_Dir( $OBT->{DIR_FTP} );
   
 my %files;  my %files;
 my %keep;  my %keep;
 my @delete;  my @delete;
 foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) {  foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
         opendir DIR, $DIR      opendir DIR, $DIR
                 or die "Couldn't opendir $DIR: $!";          or die "Couldn't opendir $DIR: $!";
         foreach (readdir DIR) {      foreach ( readdir DIR ) {
                 next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;          next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
   
                 if (/^([^\/]+)$/) {          if (/^([^\/]+)$/) {
                         $_ = $1;              $_ = $1;
                 } else {          }
                         die "Invalid character in $_: $!";          else {
                 }              die "Invalid character in $_: $!";
                 my $epoch = 0;          }
                 my $name  = basename($_, '.torrent');          my $epoch = 0;
           my $name = basename( $_, '.torrent' );
   
                 if (my ($base, $year, $mon, $mday, $hour, $min) =          if ( my ( $base, $year, $mon, $mday, $hour, $min )
                    /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) {              = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
           {
   
                         $mon--;              $mon--;
                         $epoch = timegm(0,$min,$hour,$mday,$mon,$year);              $epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
                         $name = $base;              $name = $base;
                 }          }
   
                 #print "Adding $_\n";          #print "Adding $_\n";
   
                 $files{$ext}{$name}{$epoch} = {          $files{$ext}{$name}{$epoch} = {
                         file      => $_,              file => $_,
                         dir       => $DIR,              dir  => $DIR,
                         path      => "$DIR/$_",              path => "$DIR/$_",
                         ext       => $ext,              ext  => $ext,
                         #year      => $year,  
                         #mon       => $mon,  
                         #mday      => $mday,  
                         #hour      => $hour,  
                         #min       => $min,  
                         name      => $name,  
                         epoch     => $epoch,  
                 };  
   
                 if (              #year      => $year,
                         $name =~ m/\A $OBT->{BASENAME} /xms &&              #mon       => $mon,
                         ! exists $Possible_Torrents{$name}              #mday      => $mday,
                 ) {              #hour      => $hour,
                         print "Would remove $_\n";              #min       => $min,
                         push @delete, $files{$ext}{$name}{$epoch};              name  => $name,
                 }              epoch => $epoch,
         }          };
         closedir DIR;  
           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;  #print Dump \%files;
 foreach my $name (sort keys %{ $files{torrent} }) {  foreach my $name ( sort keys %{ $files{torrent} } ) {
         next unless $name =~ /^$Name_Filter/;      next unless $name =~ /^$Name_Filter/;
         #print "Checking $name\n";  
   
         foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {      #print "Checking $name\n";
                 #print "\t$epoch\n";  
                 my $torrent = $files{torrent}{$name}{$epoch}{path};  
   
                 if (      foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } )
                         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;          #print "\t$epoch\n";
                 eval {          my $torrent = $files{torrent}{$name}{$epoch}{path};
                         $t = BT::MetaInfo::Cached->new(  
                                 $torrent,  
                                 {  
                                         cache_root => '/tmp/OBTFileCache'  
                                         #$OBT->{DIR_HOME} . '/FileCache'  
                                 }  
                         );  
                 };  
   
                 if ($@) {          if ( keys %{ $files{torrent}{$name} } == 1
                         warn "Error reading torrent $torrent\n";              && $files{torrent}{$name}{$epoch}{dir} eq $OBT->{DIR_TORRENT} )
                         push @delete, $files{torrent}{$name}{$epoch};          {
                         delete $files{torrent}{$name}{$epoch};  
                         next;  
                 }  
   
                 $files{torrent}{$name}{$epoch}{comment}   = $t->{comment};              #print "Skipping torrent for $name there is only one.\n";
                 my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;              next;
           }
   
                 unless (-e $OBT->{DIR_FTP} . "/$path") {          my $t;
                         print "Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n";          eval {
                         push @delete, $files{torrent}{$name}{$epoch};              $t = BT::MetaInfo::Cached->new(
                         delete $files{torrent}{$name}{$epoch};                  $torrent,
                         next;                  {   cache_root => '/tmp/OBTFileCache'
                 }  
   
                 my $hash = $t->info_hash;                          #$OBT->{DIR_HOME} . '/FileCache'
                 $hash = unpack("H*", $hash);                  }
               );
           };
   
                 undef $t;          if ($@) {
               warn "Error reading torrent $torrent\n";
               push @delete, $files{torrent}{$name}{$epoch};
               delete $files{torrent}{$name}{$epoch};
               next;
           }
   
                 $files{torrent}{$name}{$epoch}{info_hash} = $hash;          $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;
           }
   
                 if (exists $keep{$name}) {          my $hash = $t->info_hash;
                         if (exists $keep{$name}{$hash}) {          $hash = unpack( "H*", $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};  
   
                 }          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;  #print Dump \%files, \%keep, \@delete;
 #exit;  #exit;
   
 foreach (@delete) {  foreach (@delete) {
         print "Deleting '$_->{path}'\n";      print "Deleting '$_->{path}'\n";
         unlink $_->{path} or die "Couldn't unlink $_->{path}";      unlink $_->{path} or die "Couldn't unlink $_->{path}";
 }  }
   
 foreach my $name (keys %{ $files{$OBT->{META_EXT} } }) {  foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
         foreach my $epoch (keys %{ $files{ $OBT->{META_EXT} }{$name} }) {      foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
                 unless ( exists $files{torrent}{$name}{$epoch} ) {          unless ( exists $files{torrent}{$name}{$epoch} ) {
                         my $path = $files{$OBT->{META_EXT}}{$name}{$epoch}{path};              my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};
                         print "Unlinking '$path'\n";              print "Unlinking '$path'\n";
                         unlink $path or die "couldn't unlink '$path': $!";              unlink $path or die "couldn't unlink '$path': $!";
                 }          }
         }      }
 }  }
   
   
 #print Dump \%keep;  #print Dump \%keep;
 foreach my $name (keys %keep) {  foreach my $name ( keys %keep ) {
         foreach my $hash (keys %{ $keep{$name} }) {      foreach my $hash ( keys %{ $keep{$name} } ) {
                 my $file = $keep{$name}{$hash}{file} || q{};          my $file = $keep{$name}{$hash}{file} || q{};
                 my $dir  = $keep{$name}{$hash}{dir } || q{};          my $dir  = $keep{$name}{$hash}{dir}  || q{};
                 if ($dir eq $OBT->{DIR_NEW_TORRENT}) {          if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
                         print "Moving $file to current torrents\n";              print "Moving $file to current torrents\n";
                         rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file)              rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
                                 or die "Couldn't rename '$file': $!";                  or die "Couldn't rename '$file': $!";
   
                         my $name = $keep{$name}{$hash}{name};              my $name  = $keep{$name}{$hash}{name};
                         my $epoch = $keep{$name}{$hash}{epoch};              my $epoch = $keep{$name}{$hash}{epoch};
   
                         if (exists $files{txt}{$name}{$epoch}) {              if ( exists $files{txt}{$name}{$epoch} ) {
                                 my $m_file = $files{txt}{$name}{$epoch}{file};                  my $m_file = $files{txt}{$name}{$epoch}{file};
                                 my $m_dir  = $files{txt}{$name}{$epoch}{dir };                  my $m_dir  = $files{txt}{$name}{$epoch}{dir};
                                 rename(                  rename( "$m_dir/$m_file",
                                         "$m_dir/$m_file",                      $OBT->{DIR_TORRENT} . "/" . $m_file )
                                         $OBT->{DIR_TORRENT} . "/" . $m_file                      or die "Couldn't rename '$m_file': $!";
                                 ) or die "Couldn't rename '$m_file': $!";              }
                         }          }
                 }      }
         }  
 }  }
   
 sub Process_Dir  sub Process_Dir {
 {      my $basedir = shift;
         my $basedir = shift;  
   
         my ($dirs, $files) = Get_Files_and_Dirs($basedir);      my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
         if (@$files) {      if (@$files) {
                 my $dir = $basedir;          my $dir = $basedir;
                 $dir =~ s/^$OBT->{DIR_FTP}\///;          $dir =~ s/^$OBT->{DIR_FTP}\///;
                 my $torrent = Name_Torrent($dir);          my $torrent = Name_Torrent($dir);
                 $torrent =~ s/-.*$//;          $torrent =~ s/-.*$//;
                 $Possible_Torrents{$torrent} = 1;          $Possible_Torrents{$torrent} = 1;
                 foreach my $file (@$files) {          foreach my $file (@$files) {
                         if ($file =~ /$INSTALL_ISO_REGEX/) {              if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
                                 $torrent = Name_Torrent("$dir/$file");                  $torrent = Name_Torrent("$dir/$file");
                                 $torrent =~ s/-.*$//;                  $torrent =~ s/-.*$//;
                                 $Possible_Torrents{$torrent} = 1;                  $Possible_Torrents{$torrent} = 1;
                         }              }
                 }  
         }          }
       }
   
         foreach my $subdir (@$dirs) {      foreach my $subdir (@$dirs) {
                 next if $subdir eq '.';          next if $subdir eq '.';
                 next if $subdir eq '..';          next if $subdir eq '..';
                 Process_Dir("$basedir/$subdir")          Process_Dir("$basedir/$subdir");
         }      }
 }  }
   
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>