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

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

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

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