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

Diff for /openbsd/OpenBSDTorrents/CurrentTorrents.pl between version 1.10 and 1.38

version 1.10, 2005/04/06 23:40:20 version 1.38, 2010/03/22 21:36:28
Line 1 
Line 1 
 #!/usr/bin/perl -T  #!/usr/bin/perl -T
 #$Id$  #$RedRiver: CurrentTorrents.pl,v 1.37 2010/03/16 22:40:18 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use diagnostics;  use diagnostics;
   
 use BT::MetaInfo;  
 use Time::Local;  use Time::Local;
   use Fcntl ':flock';
   use File::Basename;
   
   use Transmission::Client;
   use Transmission::Utils;
   
   #use YAML;
   
 use lib 'lib';  use lib 'lib';
 use OpenBSDTorrents;  use OpenBSDTorrents;
   use BT::MetaInfo::Cached;
   
 %ENV = ();  %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;  my %files;
 opendir DIR, $OBT->{DIR_TORRENT}  my @delete;
         or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";  foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
 foreach (readdir DIR) {      opendir DIR, $DIR
         if (/^([^\/]+)$/) {          or die "Couldn't opendir $DIR: $!";
                 $_ = $1;      foreach ( readdir DIR ) {
         } else {          next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
                 die "Invalid character in $_: $!";  
         }  
         next unless /\.torrent$/;  
         my ($name, $year, $mon, $mday, $hour, $min) =  
            /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;  
   
         $mon--;          if (/^([^\/]+)$/) {
         my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);              $_ = $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} = {              $mon--;
                 file      => $_,              $epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
                 year      => $year,              $name = $base;
                 mon       => $mon,          }
                 mday      => $mday,  
                 hour      => $hour,  
                 min       => $min,  
                 epoch     => $epoch,  
         };  
   
           #print "Adding $DIR/$_\n";
   
           my $ct = {
               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 impossible $_\n";
               push @delete, $ct;
           }
           else {
                   if ($files{$ext}{$name}{$epoch}) {
                       warn "Multiple torrents with $name and epoch $epoch\n";
                       push @delete, $files{$ext}{$name}{$epoch};
                   }
   
                   $files{$ext}{$name}{$epoch} = $ct;
           }
   
       }
       closedir DIR;
 }  }
 closedir DIR;  
   
   #print Dump \%files;
   
 my %keep;  my %keep;
 my @delete;  my %seen;
 foreach my $name (keys %files) {  foreach my $name ( sort keys %{ $files{torrent} } ) {
         #print "$name\n";      next unless $name =~ /^$Name_Filter/;
   
         foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {      #next if $name !~ /songs/xms;
                 #print "\t$epoch\n";      #next if $name =~ /_packages_/xms;
                 my $torrent = $files{$name}{$epoch}{file};      #print "Checking $name\n";
   
                 my $t;      my $cn = $files{torrent}{$name};
                 eval { $t = BT::MetaInfo->new($OBT->{DIR_TORRENT} . "/$torrent"); };  
                 if ($@) {  
                         warn "Error reading torrent $torrent\n";  
                         next;  
                 }  
   
                 $files{$name}{$epoch}{comment}   = $t->{comment};  EPOCH: foreach my $epoch ( sort { $b <=> $a } keys %{$cn} ) {
                 my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;          my $ct = $cn->{$epoch};
           my $cf = $ct->{dir} . '/' . $ct->{file};
   
                 unless (-d $OBT->{DIR_FTP} . "/$path") {          #print "\t$epoch - $cf\n";
                         #print "Deleting $files{$name}{$epoch}{file} the path doesn't exist.\n";  
                         push @delete, $files{$name}{$epoch}{file};  
                 }  
   
                 if (keys %{ $files{$name} } == 1) {          my $t;
                         #print "Skipping torrent for $name there is only one.\n";          eval {
                         next;              $t
                 }                  = BT::MetaInfo::Cached->new( $cf,
                   { cache_root => '/tmp/OBTFileCache' } );
           };
   
                 my $hash = $t->info_hash;          if ($@) {
                 $hash = unpack("H*", $hash);              warn "Error reading torrent $cf\n";
               push @delete, $ct;
               next EPOCH;
           }
   
                 $files{$name}{$epoch}{info_hash} = $hash;          $ct->{comment} = $t->{comment};
           my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
   
                 undef $t;          if ( !-e $OBT->{DIR_FTP} . "/$path" ) {
               print
                   'Deleting ',
                   $cn->{$epoch}{file}, ' the path (', $path,
                   ") doesn't exist.\n";
               push @delete, $ct;
               next EPOCH;
           }
   
                 if (exists $keep{$name}) {          my $hash = unpack( "H*", $t->info_hash );
                         if (exists $keep{$name}{$hash}) {          $ct->{info_hash} = $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};  
   
                 }          undef $t;
         }  
           if ( $seen{$name} && $seen{$name} ne $hash ) {
               print "Removing older [$name] [$hash]\n\t",
                   $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 ) {
                   next EPOCH;
               }
   
               print "Removing duplicate [$name] [$hash]\n\t",
                   $keep{$hash}{file}, "\n";
   
               $keep{$hash}{reason} = 'duplicate';
               $ct->{reason} = 'duplicate';
   
               push @delete, $keep{$hash};
           }
           else {
               $ct->{reason} = 'first';
           }
   
           $keep{$hash} = $ct;
           $seen{$name} = $hash;
       }
 }  }
   
 #print Dump \%files, \%keep, \@delete;  #print Dump \%files, \%keep, \@delete;
   #print Dump \%keep, \@delete;
   #exit;
   
   my $client = Transmission::Client->new;
   my %seeding;
   foreach my $torrent ( @{ $client->torrents } ) {
   
       #my $status = Transmission::Utils::from_numeric_status($torrent->status);
       my $hash = $torrent->hash_string;
       if ( exists $keep{$hash} ) {
           $seeding{$hash} = $torrent;
       }
       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;
   foreach my $hash ( keys %keep ) {
       my $file = $keep{$hash}{file} || 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} ) {
           print "Moving $file to current torrents\n";
           rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
               or die "Couldn't rename '$file': $!";
   
           $dir = $OBT->{DIR_TORRENT};
           $keep{$hash}{dir} = $dir;
   
           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': $!";
               $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) {  foreach (@delete) {
         print "Deleting '$_'\n";      my $path = $_->{dir} . '/' . $_->{file};
         unlink $OBT->{TORRENTDIR} . "/$_" or die "Couldn't unlink $_";      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 {
       my $basedir = shift;
   
       my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
       if (@$files) {
           my $dir = $basedir;
           $dir =~ s/^$OBT->{DIR_FTP}\///;
           Make_Possible($dir);
           foreach my $file (@$files) {
               if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
                   Make_Possible("$dir/$file");
               }
               elsif ( $file =~ /$SONG_REGEX/xms ) {
                   Make_Possible("$dir/$1");
               }
           }
       }
   
       foreach my $subdir (@$dirs) {
           next if $subdir eq '.';
           next if $subdir eq '..';
           Process_Dir("$basedir/$subdir");
       }
   }
   
   sub Make_Possible {
       my ($path) = @_;
   
       my $torrent = Name_Torrent($path);
       $torrent =~ s/-.*$//;
       $Possible_Torrents{$torrent} = 1;
   
       return $torrent;
 }  }
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.38
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>