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

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

1.1       andrew      1: #!/usr/bin/perl -T
1.35    ! andrew      2: #$RedRiver: CurrentTorrents.pl,v 1.34 2010/03/03 18:31:57 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,
1.35    ! andrew     66:             #path => "$DIR/$_",
1.27      andrew     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};
1.35    ! andrew    103:         my $cf = $ct->{dir} . '/' . $ct->{file};
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",
1.35    ! andrew    139:                 $cf,
1.31      andrew    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",
1.35    ! andrew    154:                 $keep{$hash}{file}, "\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.35    ! andrew    210:        $keep{$hash}{dir} = $dir;
1.28      andrew    211:
                    212:         if ( exists $files{txt}{$name}{$epoch} ) {
                    213:             my $m_file = $files{txt}{$name}{$epoch}{file};
                    214:             my $m_dir  = $files{txt}{$name}{$epoch}{dir};
                    215:             rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )
                    216:                 or die "Couldn't rename '$m_file': $!";
1.35    ! andrew    217:             $files{txt}{$name}{$epoch}{dir} = $OBT->{DIR_TORRENT};
1.27      andrew    218:         }
                    219:     }
1.29      andrew    220:
                    221:     if ( !$seeding{$hash} ) {
1.34      andrew    222:         print 'Starting seed of ' . $reason . "[$file] [$hash]\n";
1.29      andrew    223:         if (!$client->add(
                    224:                 filename     => "$dir/$file",
                    225:                 download_dir => $OBT->{DIR_FTP},
                    226:             )
                    227:             )
                    228:         {
                    229:
                    230:             #warn $client->error, ": $dir/$file\n";
1.35    ! andrew    231:             print "Removing invalid torrent\n\t", $keep{$hash}{file}, "\n";
1.29      andrew    232:             push @delete, $keep{$hash};
                    233:         }
                    234:     }
                    235: }
                    236:
                    237: foreach (@delete) {
1.35    ! andrew    238:     my $path = $_->{dir} . '/' . $_->{file};
        !           239:     if ( -e $path ) {
        !           240:         print "Deleting '$path'\n";
        !           241:         unlink $path or die "Couldn't delete $path";
1.31      andrew    242:         delete $files{torrent}{ $_->{name} }{ $_->{epoch} };
1.29      andrew    243:     }
                    244:     else {
                    245:         use Data::Dumper;
                    246:         print Dumper $_;
                    247:     }
                    248: }
                    249:
                    250: foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
                    251:     foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
                    252:         unless ( exists $files{torrent}{$name}{$epoch} ) {
1.35    ! andrew    253:             my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{dir}
        !           254:                      . '/'
        !           255:                      . $files{ $OBT->{META_EXT} }{$name}{$epoch}{file};
        !           256:
1.29      andrew    257:             print "Unlinking '$path'\n";
                    258:             unlink $path or die "couldn't unlink '$path': $!";
                    259:         }
                    260:     }
1.13      andrew    261: }
1.29      andrew    262:
                    263: $client->start;
1.13      andrew    264:
1.27      andrew    265: sub Process_Dir {
                    266:     my $basedir = shift;
1.13      andrew    267:
1.27      andrew    268:     my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
                    269:     if (@$files) {
                    270:         my $dir = $basedir;
                    271:         $dir =~ s/^$OBT->{DIR_FTP}\///;
1.31      andrew    272:         Make_Possible($dir);
1.27      andrew    273:         foreach my $file (@$files) {
                    274:             if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
1.31      andrew    275:                 Make_Possible("$dir/$file");
1.27      andrew    276:             }
1.15      andrew    277:         }
1.27      andrew    278:     }
                    279:
                    280:     foreach my $subdir (@$dirs) {
                    281:         next if $subdir eq '.';
                    282:         next if $subdir eq '..';
                    283:         Process_Dir("$basedir/$subdir");
                    284:     }
1.15      andrew    285: }
                    286:
1.31      andrew    287: sub Make_Possible {
                    288:     my ($path) = @_;
                    289:
                    290:     my $torrent = Name_Torrent($path);
                    291:     $torrent =~ s/-.*$//;
                    292:     $Possible_Torrents{$torrent} = 1;
                    293:
                    294:     return $torrent;
                    295: }

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