Return to ServerTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

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