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

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

1.1       andrew      1: #!/usr/bin/perl -T
1.13    ! andrew      2: #$Id: CurrentTorrents.pl,v 1.12 2005/05/02 20:27:00 andrew Exp andrew $
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
1.2       andrew      7: use Time::Local;
1.1       andrew      8:
1.9       andrew      9: use lib 'lib';
1.1       andrew     10: use OpenBSDTorrents;
1.13    ! andrew     11: use BT::OBTMetaInfo;
1.1       andrew     12:
                     13: %ENV = ();
                     14:
1.13    ! 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.13    ! andrew     27: foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) {
        !            28:        opendir DIR, $DIR
        !            29:                or die "Couldn't opendir $DIR: $!";
        !            30:        foreach (readdir DIR) {
        !            31:                next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
1.2       andrew     32:
1.13    ! andrew     33:                if (/^([^\/]+)$/) {
        !            34:                        $_ = $1;
        !            35:                } else {
        !            36:                        die "Invalid character in $_: $!";
        !            37:                }
        !            38:                my ($name, $year, $mon, $mday, $hour, $min) =
        !            39:                   /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
1.2       andrew     40:
1.13    ! andrew     41:                $mon--;
        !            42:                my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
1.2       andrew     43:
1.13    ! andrew     44:                #print "Adding $_\n";
1.2       andrew     45:
1.13    ! andrew     46:                $files{$ext}{$name}{$epoch} = {
        !            47:                        file      => $_,
        !            48:                        dir       => $DIR,
        !            49:                        path      => "$DIR/$_",
        !            50:                        ext       => $ext,
        !            51:                        year      => $year,
        !            52:                        mon       => $mon,
        !            53:                        mday      => $mday,
        !            54:                        hour      => $hour,
        !            55:                        min       => $min,
        !            56:                        name      => $name,
        !            57:                        epoch     => $epoch,
        !            58:                };
        !            59:
        !            60:        }
        !            61:        closedir DIR;
1.2       andrew     62: }
                     63:
                     64: my %keep;
                     65: my @delete;
1.13    ! andrew     66: foreach my $name (keys %{ $files{torrent} }) {
1.12      andrew     67:        next unless $name =~ /^$Name_Filter/;
                     68:        print "Checking $name\n";
1.4       andrew     69:
1.13    ! andrew     70:        foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {
1.4       andrew     71:                #print "\t$epoch\n";
1.13    ! andrew     72:                my $torrent = $files{torrent}{$name}{$epoch}{path};
1.4       andrew     73:
                     74:                my $t;
1.13    ! andrew     75:                eval { $t = BT::OBTMetaInfo->new( $torrent ); };
        !            76:
1.4       andrew     77:                if ($@) {
                     78:                        warn "Error reading torrent $torrent\n";
                     79:                        next;
                     80:                }
                     81:
1.13    ! andrew     82:                $files{torrent}{$name}{$epoch}{comment}   = $t->{comment};
1.4       andrew     83:                my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
                     84:
1.10      andrew     85:                unless (-d $OBT->{DIR_FTP} . "/$path") {
1.13    ! andrew     86:                        #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n";
        !            87:                        push @delete, $files{torrent}{$name}{$epoch};
        !            88:                        delete $files{torrent}{$name}{$epoch};
        !            89:                        next;
1.4       andrew     90:                }
                     91:
1.13    ! andrew     92:                if (
        !            93:                        keys %{ $files{torrent}{$name} } == 1 &&
        !            94:                        $files{torrent}{$name}{$epoch}{dir}
        !            95:                                eq $OBT->{DIR_TORRENT}
        !            96:                ) {
1.7       andrew     97:                        #print "Skipping torrent for $name there is only one.\n";
1.4       andrew     98:                        next;
                     99:                }
                    100:
1.13    ! andrew    101:                my $hash = $t->info_hash_cached($torrent);
1.4       andrew    102:                $hash = unpack("H*", $hash);
                    103:
1.13    ! andrew    104:                $files{torrent}{$name}{$epoch}{info_hash} = $hash;
1.4       andrew    105:
                    106:                undef $t;
                    107:
1.2       andrew    108:                if (exists $keep{$name}) {
                    109:                        if (exists $keep{$name}{$hash}) {
                    110:                                push @delete, $keep{$name}{$hash};
1.13    ! andrew    111:                                delete $files{torrent}{
        !           112:                                        $keep{$name}{$hash}{name}
        !           113:                                }{
        !           114:                                        $keep{$name}{$hash}{epoch}
        !           115:                                };
1.2       andrew    116:                                $keep{$name}{$hash} =
1.13    ! andrew    117:                                        $files{torrent}{$name}{$epoch};
1.2       andrew    118:                        } else {
1.13    ! andrew    119:                                push @delete, $files{torrent}{$name}{$epoch};
        !           120:                                delete $files{torrent}{$name}{$epoch};
1.2       andrew    121:                        }
                    122:                } else {
                    123:                        $keep{$name}{$hash} =
1.13    ! andrew    124:                                $files{torrent}{$name}{$epoch};
1.2       andrew    125:
                    126:                }
                    127:        }
                    128: }
                    129:
                    130: #print Dump \%files, \%keep, \@delete;
                    131:
                    132: foreach (@delete) {
1.13    ! andrew    133:        print "Deleting '$_->{path}'\n";
        !           134:        unlink $_->{path} or die "Couldn't unlink $_->{path}";
        !           135: }
        !           136:
        !           137: foreach my $name (keys %{ $files{$OBT->{META_EXT} } }) {
        !           138:        foreach my $epoch (keys %{ $files{ $OBT->{META_EXT} }{$name} }) {
        !           139:                unless ( exists $files{torrent}{$name}{$epoch} ) {
        !           140:                        my $path = $files{$OBT->{META_EXT}}{$name}{$epoch}{path};
        !           141:                        print "Unlinking '$path'\n";
        !           142:                        unlink $path or die "couldn't unlink '$path': $!";
        !           143:                }
        !           144:        }
        !           145: }
        !           146:
        !           147:
        !           148: #print Dump \%keep;
        !           149: foreach my $name (keys %keep) {
        !           150:        foreach my $hash (keys %{ $keep{$name} }) {
        !           151:                my $file = $keep{$name}{$hash}{file};
        !           152:                my $dir  = $keep{$name}{$hash}{dir };
        !           153:                if ($dir eq $OBT->{DIR_NEW_TORRENT}) {
        !           154:                        print "Moving $file to current torrents\n";
        !           155:                        rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file)
        !           156:                                or die "Couldn't rename '$file': $!";
        !           157:
        !           158:                        my $name = $keep{$name}{$hash}{name};
        !           159:                        my $epoch = $keep{$name}{$hash}{epoch};
        !           160:
        !           161:                        if (exists $files{txt}{$name}{$epoch}) {
        !           162:                                my $m_file = $files{txt}{$name}{$epoch}{file};
        !           163:                                my $m_dir  = $files{txt}{$name}{$epoch}{dir };
        !           164:                                rename(
        !           165:                                        "$m_dir/$m_file",
        !           166:                                        $OBT->{DIR_TORRENT} . "/" . $m_file
        !           167:                                ) or die "Couldn't rename '$m_file': $!";
        !           168:                        }
        !           169:                }
        !           170:        }
1.2       andrew    171: }

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