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

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

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

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