Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.17
1.1 andrew 1: #!/usr/bin/perl -T
1.17 ! andrew 2: #$Id: ServerTorrents.pl,v 1.16 2005/05/07 19:01:01 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.17 ! andrew 60: my $t;
! 61: eval {
! 62: $t = BT::MetaInfo::Cached->new(
! 63: $_,
! 64: {
! 65: cache_root =>
! 66: $OBT->{DIR_HOME} . '/FileCache'
! 67: }
! 68: );
! 69: };
1.9 andrew 70:
1.17 ! andrew 71: if ($@) {
! 72: warn "Error reading torrent $_\n";
! 73: return undef;
! 74: }
1.1 andrew 75:
1.17 ! andrew 76: my $epoch = $t->creation_date;
1.1 andrew 77:
78: $files{$name}{$epoch} = {
79: file => $_,
1.17 ! andrew 80: details => $t,
! 81: name => $name,
1.1 andrew 82: epoch => $epoch,
83: };
84:
85: }
86: closedir DIR;
87:
88: #print Dump \%server_torrents, \%files;
89:
90: foreach my $name (keys %files) {
91: #print "$name\n";
92: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
93: #print "\t$epoch\n";
94: my $torrent = $files{$name}{$epoch}{file};
95: unless (exists $server_torrents{$torrent} ) {
1.9 andrew 96: #my $time =
97: # $files{$name}{$epoch}{year} . '-' .
98: # $files{$name}{$epoch}{mon} . '-' .
99: # $files{$name}{$epoch}{mday} . ' ' .
100: # $files{$name}{$epoch}{hour} . ':' .
101: # $files{$name}{$epoch}{min} . ':00';
1.1 andrew 102:
1.17 ! andrew 103: Upload_Torrent($files{$name}{$epoch});
1.1 andrew 104: }
105: next;
106: }
107: }
108:
109: foreach my $file (keys %server_torrents) {
1.2 andrew 110: my ($name, $year, $mon, $mday, $hour, $min) =
111: $file =~
112: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
113: unless (exists $files{$name}) {
1.1 andrew 114: Delete_Torrent($file);
115: }
116: }
117:
1.10 andrew 118: $ua->get($OBT->{URL_SANITY});
1.1 andrew 119:
120: sub Upload_Torrent
121: {
1.17 ! andrew 122: my $torrent = shift;
! 123: my $t = $torrent->{'details'};
1.1 andrew 124:
1.17 ! andrew 125: my $file = $torrent->{'file'};
1.1 andrew 126: print "Uploading $file\n";
127:
1.3 andrew 128: my $size = $t->total_size;
1.17 ! andrew 129: my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
! 130: gmtime($t->creation_date);
! 131: $year += 1900;
! 132: $mon++;
! 133: my $time = sprintf "%04d.%02d.%02d %02d:%02d",
! 134: $year, $mon, $mday, $hour, $min;
1.3 andrew 135:
1.13 andrew 136: my $i = 0;
1.3 andrew 137: while ($size > 1024) {
138: $size /= 1024;
139: $i++;
140: }
141: $size = sprintf('%.2f', $size);
142: $size .= $Sizes[$i] . 'B';
143:
1.1 andrew 144: my $comment = $t->{comment};
145: $comment =~ s/\n.*$//s;
1.3 andrew 146:
147: my ($filename) = $comment =~ /Files from (.+)/;
1.1 andrew 148: $filename =~ s#/# #g;
149:
1.3 andrew 150: $comment .= " [$size]";
151: $filename .= " [$time]";
1.1 andrew 152:
1.10 andrew 153: my $response = $ua->post($OBT->{URL_UPLOAD}, {
154: username => $OBT->{UPLOAD_USER},
155: password => $OBT->{UPLOAD_PASS},
156: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
1.1 andrew 157: url => "/torrents/$file",
158: filename => $filename,
159: filedate => $time,
160: info => $comment,
161: hash => '',
162: autoset => 'enabled', # -> checked="checked"
163: }, Content_Type => 'form-data');
164:
165: if ($response->is_success) {
1.6 andrew 166: print STDERR "Uploaded $file\n";
1.1 andrew 167: #print $response->content;
168: } else {
169: die $response->status_line;
170: }
171: }
172:
173: sub Delete_Torrent
174: {
175: my $file = shift;
176: print "Will delete $file soon enough\n";
177: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>