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

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

1.1       andrew      1: #!/usr/bin/perl -T
1.20    ! andrew      2: #$Id: CurrentTorrents.pl,v 1.19 2005/06/01 17:52:14 andrew Exp andrew $
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.1       andrew      9:
1.9       andrew     10: use lib 'lib';
1.1       andrew     11: use OpenBSDTorrents;
1.17      andrew     12: use BT::MetaInfo::Cached;
1.1       andrew     13:
                     14: %ENV = ();
                     15:
1.13      andrew     16: use YAML;
1.6       andrew     17:
1.15      andrew     18: #justme();
1.1       andrew     19:
1.12      andrew     20: my $Name_Filter = shift || '';
                     21: if ($Name_Filter =~ /^(\w*)$/) {
                     22:        $Name_Filter = $1;
                     23: } else {
                     24:        die "Invalid filter: $Name_Filter";
                     25: }
                     26:
1.15      andrew     27: my %Possible_Torrents;
                     28: Process_Dir($OBT->{DIR_FTP});
                     29:
1.2       andrew     30: my %files;
1.15      andrew     31: my %keep;
                     32: my @delete;
1.13      andrew     33: foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) {
                     34:        opendir DIR, $DIR
                     35:                or die "Couldn't opendir $DIR: $!";
                     36:        foreach (readdir DIR) {
                     37:                next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
1.2       andrew     38:
1.13      andrew     39:                if (/^([^\/]+)$/) {
                     40:                        $_ = $1;
                     41:                } else {
                     42:                        die "Invalid character in $_: $!";
                     43:                }
                     44:                my ($name, $year, $mon, $mday, $hour, $min) =
                     45:                   /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
1.2       andrew     46:
1.13      andrew     47:                $mon--;
                     48:                my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
1.2       andrew     49:
1.13      andrew     50:                #print "Adding $_\n";
1.2       andrew     51:
1.13      andrew     52:                $files{$ext}{$name}{$epoch} = {
                     53:                        file      => $_,
                     54:                        dir       => $DIR,
                     55:                        path      => "$DIR/$_",
                     56:                        ext       => $ext,
                     57:                        year      => $year,
                     58:                        mon       => $mon,
                     59:                        mday      => $mday,
                     60:                        hour      => $hour,
                     61:                        min       => $min,
                     62:                        name      => $name,
                     63:                        epoch     => $epoch,
                     64:                };
                     65:
1.15      andrew     66:                unless (exists $Possible_Torrents{$name}) {
                     67:                        print "Would remove $_\n";
                     68:                        push @delete, $files{$ext}{$name}{$epoch};
                     69:                }
1.13      andrew     70:        }
                     71:        closedir DIR;
1.2       andrew     72: }
                     73:
1.13      andrew     74: foreach my $name (keys %{ $files{torrent} }) {
1.12      andrew     75:        next unless $name =~ /^$Name_Filter/;
                     76:        print "Checking $name\n";
1.4       andrew     77:
1.13      andrew     78:        foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {
1.4       andrew     79:                #print "\t$epoch\n";
1.13      andrew     80:                my $torrent = $files{torrent}{$name}{$epoch}{path};
1.4       andrew     81:
1.14      andrew     82:                if (
                     83:                        keys %{ $files{torrent}{$name} } == 1 &&
                     84:                        $files{torrent}{$name}{$epoch}{dir}
                     85:                                eq $OBT->{DIR_TORRENT}
                     86:                ) {
                     87:                        #print "Skipping torrent for $name there is only one.\n";
                     88:                        next;
                     89:                }
                     90:
1.4       andrew     91:                my $t;
1.18      andrew     92:                eval {
                     93:                        $t = BT::MetaInfo::Cached->new(
                     94:                                $torrent,
                     95:                                {
                     96:                                        cache_root =>
                     97:                                        $OBT->{DIR_HOME} . '/FileCache'
                     98:                                }
                     99:                        );
                    100:                };
1.13      andrew    101:
1.4       andrew    102:                if ($@) {
                    103:                        warn "Error reading torrent $torrent\n";
                    104:                        next;
                    105:                }
                    106:
1.13      andrew    107:                $files{torrent}{$name}{$epoch}{comment}   = $t->{comment};
1.4       andrew    108:                my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
                    109:
1.10      andrew    110:                unless (-d $OBT->{DIR_FTP} . "/$path") {
1.13      andrew    111:                        #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n";
                    112:                        push @delete, $files{torrent}{$name}{$epoch};
                    113:                        delete $files{torrent}{$name}{$epoch};
1.4       andrew    114:                        next;
                    115:                }
                    116:
1.17      andrew    117:                my $hash = $t->info_hash;
1.4       andrew    118:                $hash = unpack("H*", $hash);
                    119:
1.16      andrew    120:                undef $t;
                    121:
1.13      andrew    122:                $files{torrent}{$name}{$epoch}{info_hash} = $hash;
1.4       andrew    123:
                    124:
1.2       andrew    125:                if (exists $keep{$name}) {
                    126:                        if (exists $keep{$name}{$hash}) {
                    127:                                push @delete, $keep{$name}{$hash};
1.13      andrew    128:                                delete $files{torrent}{
                    129:                                        $keep{$name}{$hash}{name}
                    130:                                }{
                    131:                                        $keep{$name}{$hash}{epoch}
                    132:                                };
1.2       andrew    133:                                $keep{$name}{$hash} =
1.13      andrew    134:                                        $files{torrent}{$name}{$epoch};
1.2       andrew    135:                        } else {
1.13      andrew    136:                                push @delete, $files{torrent}{$name}{$epoch};
                    137:                                delete $files{torrent}{$name}{$epoch};
1.2       andrew    138:                        }
                    139:                } else {
                    140:                        $keep{$name}{$hash} =
1.13      andrew    141:                                $files{torrent}{$name}{$epoch};
1.2       andrew    142:
                    143:                }
                    144:        }
                    145: }
                    146:
                    147: #print Dump \%files, \%keep, \@delete;
                    148:
                    149: foreach (@delete) {
1.13      andrew    150:        print "Deleting '$_->{path}'\n";
                    151:        unlink $_->{path} or die "Couldn't unlink $_->{path}";
                    152: }
                    153:
                    154: foreach my $name (keys %{ $files{$OBT->{META_EXT} } }) {
                    155:        foreach my $epoch (keys %{ $files{ $OBT->{META_EXT} }{$name} }) {
                    156:                unless ( exists $files{torrent}{$name}{$epoch} ) {
                    157:                        my $path = $files{$OBT->{META_EXT}}{$name}{$epoch}{path};
                    158:                        print "Unlinking '$path'\n";
                    159:                        unlink $path or die "couldn't unlink '$path': $!";
                    160:                }
                    161:        }
                    162: }
                    163:
                    164:
1.20    ! andrew    165: #print Dump \%keep;
        !           166: foreach my $name (keys %keep) {
        !           167:        foreach my $hash (keys %{ $keep{$name} }) {
        !           168:                my $file = $keep{$name}{$hash}{file};
        !           169:                my $dir  = $keep{$name}{$hash}{dir };
        !           170:                if ($dir eq $OBT->{DIR_NEW_TORRENT}) {
        !           171:                        print "Moving $file to current torrents\n";
        !           172:                        rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file)
        !           173:                                or die "Couldn't rename '$file': $!";
        !           174:
        !           175:                        my $name = $keep{$name}{$hash}{name};
        !           176:                        my $epoch = $keep{$name}{$hash}{epoch};
        !           177:
        !           178:                        if (exists $files{txt}{$name}{$epoch}) {
        !           179:                                my $m_file = $files{txt}{$name}{$epoch}{file};
        !           180:                                my $m_dir  = $files{txt}{$name}{$epoch}{dir };
        !           181:                                rename(
        !           182:                                        "$m_dir/$m_file",
        !           183:                                        $OBT->{DIR_TORRENT} . "/" . $m_file
        !           184:                                ) or die "Couldn't rename '$m_file': $!";
        !           185:                        }
        !           186:                }
        !           187:        }
        !           188: }
1.15      andrew    189:
                    190: sub Process_Dir
                    191: {
                    192:         my $basedir = shift;
                    193:
                    194:         my ($dirs, $files) = Get_Files_and_Dirs($basedir);
                    195:         if (@$files) {
                    196:                my $dir = $basedir;
                    197:                $dir =~ s/^$OBT->{DIR_FTP}\///;
                    198:                 my $torrent = Name_Torrent($dir);
                    199:                $torrent =~ s/-.*$//;
                    200:                $Possible_Torrents{$torrent} = 1;
                    201:         }
                    202:
                    203:         foreach my $subdir (@$dirs) {
                    204:                 next if $subdir eq '.';
                    205:                 next if $subdir eq '..';
                    206:                 Process_Dir("$basedir/$subdir")
                    207:         }
                    208: }
                    209:

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