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

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

1.1       andrew      1: #!/usr/bin/perl -T
1.34    ! andrew      2: #$RedRiver: CurrentTorrents.pl,v 1.33 2010/03/03 18:15:31 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:         {
1.31      andrew     81:             #print "Would remove $_\n";
1.27      andrew     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.31      andrew     95:     #next if $name !~ /songs/xms;
1.29      andrew     96:     #next if $name =~ /_packages_/xms;
1.27      andrew     97:     #print "Checking $name\n";
                     98:
1.29      andrew     99:     my $cn = $files{torrent}{$name};
1.27      andrew    100:
1.31      andrew    101: EPOCH: foreach my $epoch ( sort { $b <=> $a } keys %{$cn} ) {
1.29      andrew    102:         my $ct = $cn->{$epoch};
                    103:         my $cf = $ct->{path};
1.27      andrew    104:
1.29      andrew    105:         #print "\t$epoch - $cf\n";
1.27      andrew    106:
                    107:         my $t;
                    108:         eval {
1.29      andrew    109:             $t
                    110:                 = BT::MetaInfo::Cached->new( $cf,
                    111:                 { cache_root => '/tmp/OBTFileCache' } );
1.27      andrew    112:         };
                    113:
                    114:         if ($@) {
1.29      andrew    115:             warn "Error reading torrent $cf\n";
                    116:             push @delete, $ct;
                    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:             next EPOCH;
1.27      andrew    130:         }
                    131:
1.29      andrew    132:         my $hash = unpack( "H*", $t->info_hash );
                    133:         $ct->{info_hash} = $hash;
1.27      andrew    134:
                    135:         undef $t;
                    136:
1.29      andrew    137:         if ( $seen{$name} && $seen{$name} ne $hash ) {
1.31      andrew    138:             print "Removing older [$name] [$hash]\n\t",
                    139:                 $ct->{path},
                    140:                 "\n";
                    141:             $ct->{reason} = 'older';
1.29      andrew    142:             push @delete, $ct;
                    143:             next EPOCH;
                    144:         }
1.31      andrew    145:         elsif ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) {
                    146:             $ct->{reason} = 'only';
1.29      andrew    147:         }
                    148:         elsif ( $keep{$hash} ) {
1.28      andrew    149:             if ( $keep{$hash}{epoch} == $epoch ) {
1.29      andrew    150:                 next EPOCH;
1.27      andrew    151:             }
1.29      andrew    152:
                    153:             print "Removing duplicate [$name] [$hash]\n\t",
                    154:                 $keep{$hash}{path}, "\n";
1.31      andrew    155:
                    156:             $keep{$hash}{reason} = 'duplicate';
                    157:             $ct->{reason} = 'duplicate';
                    158:
1.28      andrew    159:             push @delete, $keep{$hash};
                    160:         }
                    161:         else {
1.31      andrew    162:             $ct->{reason} = 'first';
                    163:         }
1.2       andrew    164:
1.31      andrew    165:         $keep{$hash} = $ct;
                    166:         $seen{$name} = $hash;
1.27      andrew    167:     }
1.2       andrew    168: }
                    169:
                    170: #print Dump \%files, \%keep, \@delete;
1.31      andrew    171: #print Dump \%keep, \@delete;
1.23      andrew    172: #exit;
1.2       andrew    173:
1.29      andrew    174: my $client = Transmission::Client->new;
                    175: my %seeding;
                    176: foreach my $torrent ( @{ $client->torrents } ) {
                    177:
                    178:     #my $status = Transmission::Utils::from_numeric_status($torrent->status);
                    179:     my $hash = $torrent->hash_string;
                    180:     if ( exists $keep{$hash} ) {
                    181:         $seeding{$hash} = $torrent;
                    182:     }
                    183:     else {
                    184:         print "No longer seeding [$hash]\n";
                    185:         $torrent->stop or warn $torrent->error_string;
                    186:         $client->remove( $torrent->id ) or warn $client->error;
1.27      andrew    187:     }
1.13      andrew    188: }
                    189:
1.27      andrew    190: #print Dump \%keep;
1.28      andrew    191: foreach my $hash ( keys %keep ) {
                    192:     my $file = $keep{$hash}{file} || q{};
                    193:     my $dir  = $keep{$hash}{dir}  || q{};
1.31      andrew    194:
                    195:     my $name  = $keep{$hash}{name};
                    196:     my $epoch = $keep{$hash}{epoch};
1.33      andrew    197:     my $reason = $keep{$hash}{reason} ? $keep{$hash}{reason} . q{ } : q{};
1.31      andrew    198:
1.32      andrew    199:     #if ($reason && $reason ne 'only') {
                    200:     #    print "Keeping $reason instance of [$file] [$hash]\n",
                    201:     #        "\t", $file, "\n";
                    202:     #}
1.31      andrew    203:
1.28      andrew    204:     if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
                    205:         print "Moving $file to current torrents\n";
                    206:         rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
                    207:             or die "Couldn't rename '$file': $!";
                    208:
1.29      andrew    209:         $dir = $OBT->{DIR_TORRENT};
1.28      andrew    210:
                    211:         if ( exists $files{txt}{$name}{$epoch} ) {
                    212:             my $m_file = $files{txt}{$name}{$epoch}{file};
                    213:             my $m_dir  = $files{txt}{$name}{$epoch}{dir};
                    214:             rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )
                    215:                 or die "Couldn't rename '$m_file': $!";
1.27      andrew    216:         }
                    217:     }
1.29      andrew    218:
                    219:     if ( !$seeding{$hash} ) {
1.34    ! andrew    220:         print 'Starting seed of ' . $reason . "[$file] [$hash]\n";
1.29      andrew    221:         if (!$client->add(
                    222:                 filename     => "$dir/$file",
                    223:                 download_dir => $OBT->{DIR_FTP},
                    224:             )
                    225:             )
                    226:         {
                    227:
                    228:             #warn $client->error, ": $dir/$file\n";
                    229:             print "Removing invalid torrent\n\t", $keep{$hash}{path}, "\n";
                    230:             push @delete, $keep{$hash};
                    231:         }
                    232:     }
                    233: }
                    234:
                    235: foreach (@delete) {
                    236:     if ( $_->{path} ) {
                    237:         print "Deleting '$_->{path}'\n";
                    238:         unlink $_->{path} or die "Couldn't unlink $_->{path}";
1.31      andrew    239:         delete $files{torrent}{ $_->{name} }{ $_->{epoch} };
1.29      andrew    240:     }
                    241:     else {
                    242:         use Data::Dumper;
                    243:         print Dumper $_;
                    244:     }
                    245: }
                    246:
                    247: foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
                    248:     foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
                    249:         unless ( exists $files{torrent}{$name}{$epoch} ) {
                    250:             my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};
                    251:             print "Unlinking '$path'\n";
                    252:             unlink $path or die "couldn't unlink '$path': $!";
                    253:         }
                    254:     }
1.13      andrew    255: }
1.29      andrew    256:
                    257: $client->start;
1.13      andrew    258:
1.27      andrew    259: sub Process_Dir {
                    260:     my $basedir = shift;
1.13      andrew    261:
1.27      andrew    262:     my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
                    263:     if (@$files) {
                    264:         my $dir = $basedir;
                    265:         $dir =~ s/^$OBT->{DIR_FTP}\///;
1.31      andrew    266:         Make_Possible($dir);
1.27      andrew    267:         foreach my $file (@$files) {
                    268:             if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
1.31      andrew    269:                 Make_Possible("$dir/$file");
1.27      andrew    270:             }
1.15      andrew    271:         }
1.27      andrew    272:     }
                    273:
                    274:     foreach my $subdir (@$dirs) {
                    275:         next if $subdir eq '.';
                    276:         next if $subdir eq '..';
                    277:         Process_Dir("$basedir/$subdir");
                    278:     }
1.15      andrew    279: }
                    280:
1.31      andrew    281: sub Make_Possible {
                    282:     my ($path) = @_;
                    283:
                    284:     my $torrent = Name_Torrent($path);
                    285:     $torrent =~ s/-.*$//;
                    286:     $Possible_Torrents{$torrent} = 1;
                    287:
                    288:     return $torrent;
                    289: }

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