Return to ServerTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.1

1.1     ! andrew      1: #!/usr/bin/perl -T
        !             2: #$Id$
        !             3: use strict;
        !             4: use warnings;
        !             5: use diagnostics;
        !             6:
        !             7: use BT::MetaInfo;
        !             8: use LWP::UserAgent;
        !             9: use Time::Local;
        !            10:
        !            11: use lib 'lib';
        !            12: use OpenBSDTorrents;
        !            13:
        !            14: %ENV = ();
        !            15:
        !            16: use YAML;
        !            17:
        !            18: my $url_torrents = 'http://openbsd.somedomain.net/dumptorrents.php';
        !            19: my $url_upload   = 'http://openbsd.somedomain.net/newtorrents.php';
        !            20: my $url_delete   = 'http://openbsd.somedomain.net/deltorrents.php';
        !            21:
        !            22: my $user = 'torrentup';
        !            23: my $pass = 'ssapword';
        !            24:
        !            25: my $ua = LWP::UserAgent->new;
        !            26:
        !            27: my $response = $ua->get($url_torrents);
        !            28:
        !            29: my %server_torrents;
        !            30: if ($response->is_success) {
        !            31:     my $content = $response->content;  # or whatever
        !            32:     $content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!";
        !            33:     $content =~ s/<!-- END LIST -->.*$//s   || die "End of list not found!";
        !            34:     unless ($content =~ /No data/) {
        !            35:         foreach (split /\n/, $content) {
        !            36:             s/^\s+//;
        !            37:             s/\s+$//;
        !            38:             next unless $_;
        !            39:             my ($name, $hash) = split /\t/;
        !            40:             next if $name eq 'File';
        !            41:
        !            42:             $name =~ s#^/torrents/##;
        !            43:             $server_torrents{$name} = $hash;
        !            44:         }
        !            45:     }
        !            46: } else {
        !            47:     die $response->status_line;
        !            48: }
        !            49:
        !            50:
        !            51: my %files;
        !            52: opendir DIR, $TorrentDir or die "Couldn't opendir $TorrentDir: $!";
        !            53: foreach (readdir DIR) {
        !            54:        if (/^([^\/]+)$/) {
        !            55:                $_ = $1;
        !            56:        } else {
        !            57:                die "Invalid character in $_: $!";
        !            58:        }
        !            59:        next unless /\.torrent$/;
        !            60:        chomp;
        !            61:        my ($name, $year, $mon, $mday, $hour, $min) =
        !            62:           /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
        !            63:
        !            64:        my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
        !            65:
        !            66:        $files{$name}{$epoch} = {
        !            67:                file      => $_,
        !            68:                year      => $year,
        !            69:                mon       => $mon,
        !            70:                mday      => $mday,
        !            71:                hour      => $hour,
        !            72:                min       => $min,
        !            73:                epoch     => $epoch,
        !            74:        };
        !            75:
        !            76: }
        !            77: closedir DIR;
        !            78:
        !            79: #print Dump \%server_torrents, \%files;
        !            80:
        !            81: foreach my $name (keys %files) {
        !            82:        #print "$name\n";
        !            83:        foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
        !            84:                #print "\t$epoch\n";
        !            85:                my $torrent = $files{$name}{$epoch}{file};
        !            86:                unless (exists $server_torrents{$torrent} ) {
        !            87:                        my $time =
        !            88:                                $files{$name}{$epoch}{year} . '-' .
        !            89:                                $files{$name}{$epoch}{mon}  . '-' .
        !            90:                                $files{$name}{$epoch}{mday} . ' ' .
        !            91:                                $files{$name}{$epoch}{hour} . ':' .
        !            92:                                $files{$name}{$epoch}{min}  . ':00';
        !            93:
        !            94:                        Upload_Torrent($torrent, $time);
        !            95:                }
        !            96:                next;
        !            97:        }
        !            98: }
        !            99:
        !           100: foreach my $file (keys %server_torrents) {
        !           101:        unless (exists $files{$file}) {
        !           102:                Delete_Torrent($file);
        !           103:        }
        !           104: }
        !           105:
        !           106:
        !           107: sub Upload_Torrent
        !           108: {
        !           109:        my $file = shift;
        !           110:        my $time = shift;
        !           111:
        !           112:        print "Uploading $file\n";
        !           113:
        !           114:        my $t;
        !           115:        eval { $t = BT::MetaInfo->new("$TorrentDir/$file"); };
        !           116:        if ($@) {
        !           117:                warn "Error reading torrent $file\n";
        !           118:                return undef;
        !           119:        }
        !           120:
        !           121:        my $comment = $t->{comment};
        !           122:        $comment =~ s/\n.*$//s;
        !           123:
        !           124:        my ($filename) = $comment =~ /Files from ([^<]+)/;
        !           125:        $filename =~ s#/# #g;
        !           126:
        !           127:        $filename .= ' (' . $time . ')';
        !           128:
        !           129:        my $response = $ua->post($url_upload, {
        !           130:                username => $user,
        !           131:                password => $pass,
        !           132:                torrent  => [ "$TorrentDir/$file" ],
        !           133:                url      => "/torrents/$file",
        !           134:                filename => $filename,
        !           135:                filedate => $time,
        !           136:                info     => $comment,
        !           137:                hash     => '',
        !           138:                autoset  => 'enabled', # -> checked="checked"
        !           139:        }, Content_Type => 'form-data');
        !           140:
        !           141:        if ($response->is_success) {
        !           142:                print "Uploaded  $file\n";
        !           143:                #print $response->content;
        !           144:        } else {
        !           145:                die $response->status_line;
        !           146:        }
        !           147: }
        !           148:
        !           149: sub Delete_Torrent
        !           150: {
        !           151:        my $file = shift;
        !           152:        print "Will delete $file soon enough\n";
        !           153: }