Return to CurrentTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

1.1       andrew      1: #!/usr/bin/perl -T
1.12    ! andrew      2: #$Id: CurrentTorrents.pl,v 1.11 2005/04/06 23:04:40 andrew Exp andrew $
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
                      7: use BT::MetaInfo;
1.2       andrew      8: use Time::Local;
1.1       andrew      9:
1.9       andrew     10: use lib 'lib';
1.1       andrew     11: use OpenBSDTorrents;
                     12:
                     13: %ENV = ();
                     14:
1.2       andrew     15: #use YAML;
1.6       andrew     16:
                     17: justme();
1.1       andrew     18:
1.12    ! andrew     19: my $Name_Filter = shift || '';
        !            20: if ($Name_Filter =~ /^(\w*)$/) {
        !            21:        $Name_Filter = $1;
        !            22: } else {
        !            23:        die "Invalid filter: $Name_Filter";
        !            24: }
        !            25:
1.2       andrew     26: my %files;
1.10      andrew     27: opendir DIR, $OBT->{DIR_TORRENT}
                     28:        or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
1.2       andrew     29: foreach (readdir DIR) {
                     30:        if (/^([^\/]+)$/) {
                     31:                $_ = $1;
                     32:        } else {
                     33:                die "Invalid character in $_: $!";
                     34:        }
                     35:        next unless /\.torrent$/;
                     36:        my ($name, $year, $mon, $mday, $hour, $min) =
                     37:           /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
                     38:
1.8       andrew     39:        $mon--;
1.2       andrew     40:        my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
                     41:
1.7       andrew     42:        #print "Adding $_\n";
1.2       andrew     43:
                     44:        $files{$name}{$epoch} = {
                     45:                file      => $_,
                     46:                year      => $year,
                     47:                mon       => $mon,
                     48:                mday      => $mday,
                     49:                hour      => $hour,
                     50:                min       => $min,
                     51:                epoch     => $epoch,
                     52:        };
                     53:
                     54: }
                     55: closedir DIR;
                     56:
                     57: my %keep;
                     58: my @delete;
                     59: foreach my $name (keys %files) {
1.12    ! andrew     60:        next unless $name =~ /^$Name_Filter/;
        !            61:        print "Checking $name\n";
1.4       andrew     62:
                     63:        foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
                     64:                #print "\t$epoch\n";
                     65:                my $torrent = $files{$name}{$epoch}{file};
                     66:
                     67:                my $t;
1.10      andrew     68:                eval { $t = BT::MetaInfo->new($OBT->{DIR_TORRENT} . "/$torrent"); };
1.4       andrew     69:                if ($@) {
                     70:                        warn "Error reading torrent $torrent\n";
                     71:                        next;
                     72:                }
                     73:
                     74:                $files{$name}{$epoch}{comment}   = $t->{comment};
                     75:                my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
                     76:
1.10      andrew     77:                unless (-d $OBT->{DIR_FTP} . "/$path") {
1.7       andrew     78:                        #print "Deleting $files{$name}{$epoch}{file} the path doesn't exist.\n";
1.4       andrew     79:                        push @delete, $files{$name}{$epoch}{file};
                     80:                }
                     81:
                     82:                if (keys %{ $files{$name} } == 1) {
1.7       andrew     83:                        #print "Skipping torrent for $name there is only one.\n";
1.4       andrew     84:                        next;
                     85:                }
                     86:
                     87:                my $hash = $t->info_hash;
                     88:                $hash = unpack("H*", $hash);
                     89:
                     90:                $files{$name}{$epoch}{info_hash} = $hash;
                     91:
                     92:                undef $t;
                     93:
1.2       andrew     94:                if (exists $keep{$name}) {
                     95:                        if (exists $keep{$name}{$hash}) {
                     96:                                push @delete, $keep{$name}{$hash};
                     97:                                $keep{$name}{$hash} =
1.4       andrew     98:                                        $files{$name}{$epoch}{file};
1.2       andrew     99:                        } else {
1.4       andrew    100:                                push @delete, $files{$name}{$epoch}{file};
1.2       andrew    101:                        }
                    102:                } else {
                    103:                        $keep{$name}{$hash} =
1.4       andrew    104:                                $files{$name}{$epoch}{file};
1.2       andrew    105:
                    106:                }
                    107:        }
                    108: }
                    109:
                    110: #print Dump \%files, \%keep, \@delete;
                    111:
                    112: foreach (@delete) {
1.3       andrew    113:        print "Deleting '$_'\n";
1.11      andrew    114:        unlink $OBT->{DIR_TORRENT} . "/$_" or die "Couldn't unlink $_";
1.2       andrew    115: }