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

Diff for /openbsd/OpenBSDTorrents/CurrentTorrents.pl between version 1.28 and 1.37

version 1.28, 2010/01/05 19:55:22 version 1.37, 2010/03/16 23:40:18
Line 1 
Line 1 
 #!/usr/bin/perl -T  #!/usr/bin/perl -T
 #$RedRiver: CurrentTorrents.pl,v 1.26 2009/10/20 19:04:28 andrew Exp $  #$RedRiver: CurrentTorrents.pl,v 1.36 2010/03/16 22:37:32 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use diagnostics;  use diagnostics;
Line 8 
Line 8 
 use Fcntl ':flock';  use Fcntl ':flock';
 use File::Basename;  use File::Basename;
   
   use Transmission::Client;
   use Transmission::Utils;
   
 #use YAML;  #use YAML;
   
 use lib 'lib';  use lib 'lib';
Line 55 
Line 58 
             $name = $base;              $name = $base;
         }          }
   
         #print "Adding $_\n";          #print "Adding $DIR/$_\n";
   
           if (exists $files{$ext}{$name}{$epoch}) {
               warn "Multiple torrents with $name and epoch $epoch\n";
               push @delete, $files{$ext}{$name}{$epoch};
           }
   
         $files{$ext}{$name}{$epoch} = {          $files{$ext}{$name}{$epoch} = {
             file => $_,              file => $_,
             dir  => $DIR,              dir  => $DIR,
             path => "$DIR/$_",              #path => "$DIR/$_",
             ext  => $ext,              ext  => $ext,
   
             #year      => $year,              #year      => $year,
Line 75 
Line 83 
         if ( $name =~ m/\A $OBT->{BASENAME} /xms          if ( $name =~ m/\A $OBT->{BASENAME} /xms
             && !exists $Possible_Torrents{$name} )              && !exists $Possible_Torrents{$name} )
         {          {
             print "Would remove $_\n";              #print "Would remove $_\n";
             push @delete, $files{$ext}{$name}{$epoch};              push @delete, $files{$ext}{$name}{$epoch};
         }          }
     }      }
Line 85 
Line 93 
 #print Dump \%files;  #print Dump \%files;
   
 my %keep;  my %keep;
   my %seen;
 foreach my $name ( sort keys %{ $files{torrent} } ) {  foreach my $name ( sort keys %{ $files{torrent} } ) {
     next unless $name =~ /^$Name_Filter/;      next unless $name =~ /^$Name_Filter/;
   
       #next if $name !~ /songs/xms;
       #next if $name =~ /_packages_/xms;
     #print "Checking $name\n";      #print "Checking $name\n";
   
     foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } )      my $cn = $files{torrent}{$name};
     {  
   
         #print "\t$epoch\n";  EPOCH: foreach my $epoch ( sort { $b <=> $a } keys %{$cn} ) {
         my $torrent = $files{torrent}{$name}{$epoch}{path};          my $ct = $cn->{$epoch};
           my $cf = $ct->{dir} . '/' . $ct->{file};
   
         if ( keys %{ $files{torrent}{$name} } == 1          #print "\t$epoch - $cf\n";
             && $files{torrent}{$name}{$epoch}{dir} eq $OBT->{DIR_TORRENT} )  
         {  
   
             #print "Skipping torrent for $name there is only one.\n";  
             next;  
         }  
   
         my $t;          my $t;
         eval {          eval {
             $t = BT::MetaInfo::Cached->new(              $t
                 $torrent,                  = BT::MetaInfo::Cached->new( $cf,
                 {   cache_root => '/tmp/OBTFileCache'                  { cache_root => '/tmp/OBTFileCache' } );
   
                         #$OBT->{DIR_HOME} . '/FileCache'  
                 }  
             );  
         };          };
   
         if ($@) {          if ($@) {
             warn "Error reading torrent $torrent\n";              warn "Error reading torrent $cf\n";
             push @delete, $files{torrent}{$name}{$epoch};              push @delete, $ct;
             delete $files{torrent}{$name}{$epoch};              next EPOCH;
             next;  
         }          }
   
         $files{torrent}{$name}{$epoch}{comment} = $t->{comment};          $ct->{comment} = $t->{comment};
         my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;          my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
   
         unless ( -e $OBT->{DIR_FTP} . "/$path" ) {          if ( !-e $OBT->{DIR_FTP} . "/$path" ) {
             print              print
                 "Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n";                  'Deleting ',
             push @delete, $files{torrent}{$name}{$epoch};                  $cn->{$epoch}{file}, ' the path (', $path,
             delete $files{torrent}{$name}{$epoch};                  ") doesn't exist.\n";
             next;              push @delete, $ct;
               next EPOCH;
         }          }
   
         my $hash = $t->info_hash;          my $hash = unpack( "H*", $t->info_hash );
         $hash = unpack( "H*", $hash );          $ct->{info_hash} = $hash;
   
         undef $t;          undef $t;
   
         $files{torrent}{$name}{$epoch}{info_hash} = $hash;          if ( $seen{$name} && $seen{$name} ne $hash ) {
               print "Removing older [$name] [$hash]\n\t",
         if ( exists $keep{$hash} ) {                  $cf,
                   "\n";
               $ct->{reason} = 'older';
               push @delete, $ct;
               next EPOCH;
           }
           elsif ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) {
               $ct->{reason} = 'only';
           }
           elsif ( $keep{$hash} ) {
             if ( $keep{$hash}{epoch} == $epoch ) {              if ( $keep{$hash}{epoch} == $epoch ) {
                 next;                  next EPOCH;
             }              }
             print "Removing [$name] [$hash]\n\t", $keep{$hash}{path}, "\n";  
               print "Removing duplicate [$name] [$hash]\n\t",
                   $keep{$hash}{file}, "\n";
   
               $keep{$hash}{reason} = 'duplicate';
               $ct->{reason} = 'duplicate';
   
             push @delete, $keep{$hash};              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 {          else {
             print "Removing old [$name] [$hash]\n";              $ct->{reason} = 'first';
             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};  
   
         }          $keep{$hash} = $ct;
           $seen{$name} = $hash;
     }      }
 }  }
   
 #print Dump \%files, \%keep, \@delete;  #print Dump \%files, \%keep, \@delete;
   #print Dump \%keep, \@delete;
 #exit;  #exit;
   
 foreach (@delete) {  my $client = Transmission::Client->new;
     print "Deleting '$_->{path}'\n";  my %seeding;
     unlink $_->{path} or die "Couldn't unlink $_->{path}";  foreach my $torrent ( @{ $client->torrents } ) {
 }  
   
 foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {      #my $status = Transmission::Utils::from_numeric_status($torrent->status);
     foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {      my $hash = $torrent->hash_string;
         unless ( exists $files{torrent}{$name}{$epoch} ) {      if ( exists $keep{$hash} ) {
             my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};          $seeding{$hash} = $torrent;
             print "Unlinking '$path'\n";  
             unlink $path or die "couldn't unlink '$path': $!";  
         }  
     }      }
       else {
           print "No longer seeding [$hash]\n";
           $torrent->stop or warn $torrent->error_string;
           $client->remove( $torrent->id ) or warn $client->error;
       }
 }  }
   
 #print Dump \%keep;  #print Dump \%keep;
 foreach my $hash ( keys %keep ) {  foreach my $hash ( keys %keep ) {
     my $file = $keep{$hash}{file} || q{};      my $file = $keep{$hash}{file} || q{};
     my $dir  = $keep{$hash}{dir}  || q{};      my $dir  = $keep{$hash}{dir}  || q{};
   
       my $name  = $keep{$hash}{name};
       my $epoch = $keep{$hash}{epoch};
       my $reason = $keep{$hash}{reason} ? $keep{$hash}{reason} . q{ } : q{};
   
       #if ($reason && $reason ne 'only') {
       #    print "Keeping $reason instance of [$file] [$hash]\n",
       #        "\t", $file, "\n";
       #}
   
     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{$hash}{name};          $dir = $OBT->{DIR_TORRENT};
         my $epoch = $keep{$hash}{epoch};          $keep{$hash}{dir} = $dir;
   
         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( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )              rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )
                 or die "Couldn't rename '$m_file': $!";                  or die "Couldn't rename '$m_file': $!";
               $files{txt}{$name}{$epoch}{dir} = $OBT->{DIR_TORRENT};
         }          }
     }      }
   
       if ( !$seeding{$hash} ) {
           print 'Starting seed of ' . $reason . "[$file] [$hash]\n";
           if (!$client->add(
                   filename     => "$dir/$file",
                   download_dir => $OBT->{DIR_FTP},
               )
               )
           {
   
               #warn $client->error, ": $dir/$file\n";
               print "Removing invalid torrent\n\t", $keep{$hash}{file}, "\n";
               push @delete, $keep{$hash};
           }
       }
 }  }
   
   foreach (@delete) {
       my $path = $_->{dir} . '/' . $_->{file};
       if ( -e $path ) {
           print "Deleting '$path'\n";
           unlink $path or die "Couldn't delete $path";
           delete $files{torrent}{ $_->{name} }{ $_->{epoch} };
       }
       else {
           use Data::Dumper;
           print Dumper $_;
       }
   }
   
   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}{dir}
                        . '/'
                        . $files{ $OBT->{META_EXT} }{$name}{$epoch}{file};
   
               print "Unlinking '$path'\n";
               unlink $path or die "couldn't unlink '$path': $!";
           }
       }
   }
   
   $client->start;
   
 sub Process_Dir {  sub Process_Dir {
     my $basedir = shift;      my $basedir = shift;
   
Line 217 
Line 274 
     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);          Make_Possible($dir);
         $torrent =~ s/-.*$//;  
         $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");                  Make_Possible("$dir/$file");
                 $torrent =~ s/-.*$//;  
                 $Possible_Torrents{$torrent} = 1;  
             }              }
         }          }
     }      }
Line 236 
Line 289 
     }      }
 }  }
   
   sub Make_Possible {
       my ($path) = @_;
   
       my $torrent = Name_Torrent($path);
       $torrent =~ s/-.*$//;
       $Possible_Torrents{$torrent} = 1;
   
       return $torrent;
   }
Legend:
Removed from v.1.28  
changed lines
  Added in v.1.37
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>