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

Annotation of openbsd/OpenBSDTorrents/CurrentTorrents.pl, Revision 1.30

1.1       andrew      1: #!/usr/bin/perl -T
1.30    ! andrew      2: #$RedRiver: CurrentTorrents.pl,v 1.29 2010/01/08 17:18:35 andrew Exp $
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
1.2       andrew      7: use Time::Local;
1.16      andrew      8: use Fcntl ':flock';
1.23      andrew      9: use File::Basename;
1.27      andrew     10:
1.29      andrew     11: use Transmission::Client;
                     12: use Transmission::Utils;
                     13:
1.23      andrew     14: #use YAML;
1.1       andrew     15:
1.9       andrew     16: use lib 'lib';
1.1       andrew     17: use OpenBSDTorrents;
1.17      andrew     18: use BT::MetaInfo::Cached;
1.1       andrew     19:
                     20: %ENV = ();
                     21:
1.15      andrew     22: #justme();
1.1       andrew     23:
1.12      andrew     24: my $Name_Filter = shift || '';
1.27      andrew     25: if ( $Name_Filter =~ /^(\w*)$/ ) {
                     26:     $Name_Filter = $1;
                     27: }
                     28: else {
                     29:     die "Invalid filter: $Name_Filter";
1.12      andrew     30: }
                     31:
1.15      andrew     32: my %Possible_Torrents;
1.27      andrew     33: Process_Dir( $OBT->{DIR_FTP} );
1.15      andrew     34:
1.2       andrew     35: my %files;
1.15      andrew     36: my @delete;
1.27      andrew     37: foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
                     38:     opendir DIR, $DIR
                     39:         or die "Couldn't opendir $DIR: $!";
                     40:     foreach ( readdir DIR ) {
                     41:         next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
                     42:
                     43:         if (/^([^\/]+)$/) {
                     44:             $_ = $1;
                     45:         }
                     46:         else {
                     47:             die "Invalid character in $_: $!";
                     48:         }
                     49:         my $epoch = 0;
                     50:         my $name = basename( $_, '.torrent' );
                     51:
                     52:         if ( my ( $base, $year, $mon, $mday, $hour, $min )
                     53:             = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
                     54:         {
                     55:
                     56:             $mon--;
                     57:             $epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
                     58:             $name = $base;
                     59:         }
                     60:
                     61:         #print "Adding $_\n";
                     62:
                     63:         $files{$ext}{$name}{$epoch} = {
                     64:             file => $_,
                     65:             dir  => $DIR,
                     66:             path => "$DIR/$_",
                     67:             ext  => $ext,
                     68:
                     69:             #year      => $year,
                     70:             #mon       => $mon,
                     71:             #mday      => $mday,
                     72:             #hour      => $hour,
                     73:             #min       => $min,
                     74:             name  => $name,
                     75:             epoch => $epoch,
                     76:         };
                     77:
                     78:         if ( $name =~ m/\A $OBT->{BASENAME} /xms
                     79:             && !exists $Possible_Torrents{$name} )
                     80:         {
                     81:             print "Would remove $_\n";
                     82:             push @delete, $files{$ext}{$name}{$epoch};
                     83:         }
                     84:     }
                     85:     closedir DIR;
1.2       andrew     86: }
                     87:
1.25      andrew     88: #print Dump \%files;
1.28      andrew     89:
                     90: my %keep;
1.29      andrew     91: my %seen;
1.27      andrew     92: foreach my $name ( sort keys %{ $files{torrent} } ) {
                     93:     next unless $name =~ /^$Name_Filter/;
                     94:
1.29      andrew     95:     #next if $name =~ /_packages_/xms;
1.27      andrew     96:     #print "Checking $name\n";
                     97:
1.29      andrew     98:     my $cn = $files{torrent}{$name};
1.27      andrew     99:
1.30    ! andrew    100: EPOCH: foreach my $epoch ( sort { $a <=> $b } keys %{$cn} ) {
1.29      andrew    101:         my $ct = $cn->{$epoch};
                    102:         my $cf = $ct->{path};
1.27      andrew    103:
1.29      andrew    104:         #print "\t$epoch - $cf\n";
1.27      andrew    105:
                    106:         my $t;
                    107:         eval {
1.29      andrew    108:             $t
                    109:                 = BT::MetaInfo::Cached->new( $cf,
                    110:                 { cache_root => '/tmp/OBTFileCache' } );
1.27      andrew    111:         };
                    112:
                    113:         if ($@) {
1.29      andrew    114:             warn "Error reading torrent $cf\n";
                    115:             push @delete, $ct;
                    116:             delete $cn->{$epoch};
                    117:             next EPOCH;
1.27      andrew    118:         }
                    119:
1.29      andrew    120:         $ct->{comment} = $t->{comment};
1.27      andrew    121:         my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
                    122:
1.29      andrew    123:         if ( !-e $OBT->{DIR_FTP} . "/$path" ) {
1.27      andrew    124:             print
1.29      andrew    125:                 'Deleting ',
                    126:                 $cn->{$epoch}{file}, ' the path (', $path,
                    127:                 ") doesn't exist.\n";
                    128:             push @delete, $ct;
                    129:             delete $cn->{$epoch};
                    130:             next EPOCH;
1.27      andrew    131:         }
                    132:
1.29      andrew    133:         my $hash = unpack( "H*", $t->info_hash );
                    134:         $ct->{info_hash} = $hash;
1.27      andrew    135:
                    136:         undef $t;
                    137:
1.29      andrew    138:         if ( $seen{$name} && $seen{$name} ne $hash ) {
                    139:             print "Removing older [$name] [$hash]\n";
                    140:             if ( $keep{$hash}{path} ) {
                    141:                 print "\t", $keep{$hash}{path}, "\n";
                    142:             }
                    143:             push @delete, $ct;
                    144:             delete $cn->{$epoch};
                    145:             next EPOCH;
                    146:         }
                    147:         $seen{$name} = $hash;
                    148:
                    149:         if ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) {
                    150:             $keep{$hash} = $ct;
1.27      andrew    151:
1.29      andrew    152:             #print "Keeping only instance of [$name] [$hash]\n\t",
                    153:             #    $ct->{path},
                    154:             #    "\n";
                    155:             next EPOCH;
                    156:         }
                    157:         elsif ( $keep{$hash} ) {
1.28      andrew    158:             if ( $keep{$hash}{epoch} == $epoch ) {
1.29      andrew    159:                 next EPOCH;
1.27      andrew    160:             }
1.29      andrew    161:
                    162:             print "Removing duplicate [$name] [$hash]\n\t",
                    163:                 $keep{$hash}{path}, "\n";
1.28      andrew    164:             push @delete, $keep{$hash};
                    165:             delete $files{torrent}{ $keep{$hash}{name} }
                    166:                 { $keep{$hash}{epoch} };
1.29      andrew    167:
                    168:             $keep{$hash} = $ct;
                    169:             print "Keeping additional instance of [$name] [$hash]\n\t",
                    170:                 $ct->{path},
1.28      andrew    171:                 "\n";
                    172:         }
                    173:         else {
1.29      andrew    174:             $keep{$hash} = $ct;
                    175:             print "Keeping first instance of [$name] [$hash]\n\t",
                    176:                 $ct->{path},
1.27      andrew    177:                 "\n";
1.2       andrew    178:
1.27      andrew    179:         }
                    180:     }
1.2       andrew    181: }
                    182:
                    183: #print Dump \%files, \%keep, \@delete;
1.23      andrew    184: #exit;
1.2       andrew    185:
1.29      andrew    186: my $client = Transmission::Client->new;
                    187: my %seeding;
                    188: foreach my $torrent ( @{ $client->torrents } ) {
                    189:
                    190:     #my $status = Transmission::Utils::from_numeric_status($torrent->status);
                    191:     my $hash = $torrent->hash_string;
                    192:     if ( exists $keep{$hash} ) {
                    193:         $seeding{$hash} = $torrent;
                    194:     }
                    195:     else {
                    196:         print "No longer seeding [$hash]\n";
                    197:         $torrent->stop or warn $torrent->error_string;
                    198:         $client->remove( $torrent->id ) or warn $client->error;
1.27      andrew    199:     }
1.13      andrew    200: }
                    201:
1.27      andrew    202: #print Dump \%keep;
1.28      andrew    203: foreach my $hash ( keys %keep ) {
                    204:     my $file = $keep{$hash}{file} || q{};
                    205:     my $dir  = $keep{$hash}{dir}  || q{};
                    206:     if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
                    207:         print "Moving $file to current torrents\n";
                    208:         rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
                    209:             or die "Couldn't rename '$file': $!";
                    210:
                    211:         my $name  = $keep{$hash}{name};
                    212:         my $epoch = $keep{$hash}{epoch};
1.29      andrew    213:         $dir = $OBT->{DIR_TORRENT};
1.28      andrew    214:
                    215:         if ( exists $files{txt}{$name}{$epoch} ) {
                    216:             my $m_file = $files{txt}{$name}{$epoch}{file};
                    217:             my $m_dir  = $files{txt}{$name}{$epoch}{dir};
                    218:             rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )
                    219:                 or die "Couldn't rename '$m_file': $!";
1.27      andrew    220:         }
                    221:     }
1.29      andrew    222:
                    223:     if ( !$seeding{$hash} ) {
                    224:         print "Starting seed of [$file] [$hash]\n";
                    225:         if (!$client->add(
                    226:                 filename     => "$dir/$file",
                    227:                 download_dir => $OBT->{DIR_FTP},
                    228:             )
                    229:             )
                    230:         {
                    231:
                    232:             #warn $client->error, ": $dir/$file\n";
                    233:             print "Removing invalid torrent\n\t", $keep{$hash}{path}, "\n";
                    234:             push @delete, $keep{$hash};
                    235:             delete $files{torrent}{ $keep{$hash}{name} }
                    236:                 { $keep{$hash}{epoch} };
                    237:         }
                    238:     }
                    239: }
                    240:
                    241: foreach (@delete) {
                    242:     if ( $_->{path} ) {
                    243:         print "Deleting '$_->{path}'\n";
                    244:         unlink $_->{path} or die "Couldn't unlink $_->{path}";
                    245:     }
                    246:     else {
                    247:         use Data::Dumper;
                    248:         print Dumper $_;
                    249:     }
                    250: }
                    251:
                    252: foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
                    253:     foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
                    254:         unless ( exists $files{torrent}{$name}{$epoch} ) {
                    255:             my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};
                    256:             print "Unlinking '$path'\n";
                    257:             unlink $path or die "couldn't unlink '$path': $!";
                    258:         }
                    259:     }
1.13      andrew    260: }
1.29      andrew    261:
                    262: $client->start;
1.13      andrew    263:
1.27      andrew    264: sub Process_Dir {
                    265:     my $basedir = shift;
1.13      andrew    266:
1.27      andrew    267:     my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
                    268:     if (@$files) {
                    269:         my $dir = $basedir;
                    270:         $dir =~ s/^$OBT->{DIR_FTP}\///;
                    271:         my $torrent = Name_Torrent($dir);
                    272:         $torrent =~ s/-.*$//;
                    273:         $Possible_Torrents{$torrent} = 1;
                    274:         foreach my $file (@$files) {
                    275:             if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
                    276:                 $torrent = Name_Torrent("$dir/$file");
                    277:                 $torrent =~ s/-.*$//;
                    278:                 $Possible_Torrents{$torrent} = 1;
                    279:             }
1.15      andrew    280:         }
1.27      andrew    281:     }
                    282:
                    283:     foreach my $subdir (@$dirs) {
                    284:         next if $subdir eq '.';
                    285:         next if $subdir eq '..';
                    286:         Process_Dir("$basedir/$subdir");
                    287:     }
1.15      andrew    288: }
                    289:

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>