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

Diff for /openbsd/OpenBSDTorrents/CurrentTorrents.pl between version 1.2 and 1.16

version 1.2, 2005/03/23 01:31:41 version 1.16, 2005/05/05 02:09:43
Line 4 
Line 4 
 use warnings;  use warnings;
 use diagnostics;  use diagnostics;
   
 use BT::MetaInfo;  
 use Time::Local;  use Time::Local;
   use Fcntl ':flock';
   
 use lib 'lib';  use lib 'lib';
 use OpenBSDTorrents;  use OpenBSDTorrents;
   use BT::OBTMetaInfo;
   
 %ENV = ();  %ENV = ();
   
 #use YAML;  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 %files;
 opendir DIR, $TorrentDir or die "Couldn't opendir $TorrentDir: $!";  my %keep;
 foreach (readdir DIR) {  my @delete;
         if (/^([^\/]+)$/) {  foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) {
                 $_ = $1;          opendir DIR, $DIR
         } else {                  or die "Couldn't opendir $DIR: $!";
                 die "Invalid character in $_: $!";          foreach (readdir DIR) {
         }                  next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
         next unless /\.torrent$/;  
         my ($name, $year, $mon, $mday, $hour, $min) =  
            /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;  
   
         my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);                  if (/^([^\/]+)$/) {
                           $_ = $1;
                   } else {
                           die "Invalid character in $_: $!";
                   }
                   my ($name, $year, $mon, $mday, $hour, $min) =
                      /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
   
         my $t = BT::MetaInfo->new("$TorrentDir/$_");                  $mon--;
         my $hash = $t->info_hash;                  my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
         $hash = unpack("H*", $hash);  
   
         $files{$name}{$epoch} = {                  #print "Adding $_\n";
                 file      => $_,  
                 comment   => $t->{comment},  
                 year      => $year,  
                 mon       => $mon,  
                 mday      => $mday,  
                 hour      => $hour,  
                 min       => $min,  
                 epoch     => $epoch,  
                 info_hash => $hash,  
         };  
   
                   $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,
                   };
   
                   unless (exists $Possible_Torrents{$name}) {
                           print "Would remove $_\n";
                           push @delete, $files{$ext}{$name}{$epoch};
                   }
           }
           closedir DIR;
 }  }
 closedir DIR;  
   
   foreach my $name (keys %{ $files{torrent} }) {
           next unless $name =~ /^$Name_Filter/;
           print "Checking $name\n";
   
 my %keep;          foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {
 my @delete;                  #print "\t$epoch\n";
 foreach my $name (keys %files) {                  my $torrent = $files{torrent}{$name}{$epoch}{path};
         foreach my $time ( sort { $b <=> $a } keys %{ $files{$name} } ) {  
                 #print "$name - $time\n";                  if (
                 my $hash = $files{$name}{$time}{info_hash};                          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 $meta_file = $torrent;
                   $meta_file =~ s/\.torrent$/.$OBT->{META_EXT}/;
   
                   my $hash = undef;
                   if (-e $meta_file) {
                           #print "Reading meta file: $meta_file\n";
                           open my $meta, $meta_file
                                   or die "Couldn't open $meta_file: $!";
                           flock($meta, LOCK_SH);
                           binmode $meta;
   
                           $hash = do { local $/; <$meta> };
   
                           flock($meta, LOCK_UN);
                           close $meta;
                   } else {
   
                   my $t;
                   eval { $t = BT::OBTMetaInfo->new( $torrent ); };
   
                   if ($@) {
                           warn "Error reading torrent $torrent\n";
                           next;
                   }
   
                   $files{torrent}{$name}{$epoch}{comment}   = $t->{comment};
                   my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
   
                   unless (-d $OBT->{DIR_FTP} . "/$path") {
                           #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n";
                           push @delete, $files{torrent}{$name}{$epoch};
                           delete $files{torrent}{$name}{$epoch};
                           next;
                   }
   
                   $hash = $t->info_hash_cached($torrent);
                   $hash = unpack("H*", $hash);
   
                   undef $t;
   
                   }
   
                   $files{torrent}{$name}{$epoch}{info_hash} = $hash;
   
   
                 if (exists $keep{$name}) {                  if (exists $keep{$name}) {
                         if (exists $keep{$name}{$hash}) {                          if (exists $keep{$name}{$hash}) {
                                 push @delete, $keep{$name}{$hash};                                  push @delete, $keep{$name}{$hash};
                                   delete $files{torrent}{
                                           $keep{$name}{$hash}{name}
                                   }{
                                           $keep{$name}{$hash}{epoch}
                                   };
                                 $keep{$name}{$hash} =                                  $keep{$name}{$hash} =
                                         $files{$name}{$time}{file};                                          $files{torrent}{$name}{$epoch};
                         } else {                          } else {
                                 push @delete, $files{$name}{$time}{file};                                  push @delete, $files{torrent}{$name}{$epoch};
                                   delete $files{torrent}{$name}{$epoch};
                         }                          }
                 } else {                  } else {
                         $keep{$name}{$hash} =                          $keep{$name}{$hash} =
                                 $files{$name}{$time}{file};                                  $files{torrent}{$name}{$epoch};
   
                 }                  }
         }          }
Line 73 
Line 158 
 #print Dump \%files, \%keep, \@delete;  #print Dump \%files, \%keep, \@delete;
   
 foreach (@delete) {  foreach (@delete) {
         unlink "$TorrentDir/$_" 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 $name (keys %keep) {
           foreach my $hash (keys %{ $keep{$name} }) {
                   my $file = $keep{$name}{$hash}{file};
                   my $dir  = $keep{$name}{$hash}{dir };
                   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 $subdir (@$dirs) {
                   next if $subdir eq '.';
                   next if $subdir eq '..';
                   Process_Dir("$basedir/$subdir")
           }
   }
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.16
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>