Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.16
1.1 andrew 1: #!/usr/bin/perl -T
1.16 ! andrew 2: #$Id: ServerTorrents.pl,v 1.15 2005/05/06 20:05:00 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(
1.16 ! andrew 122: $file,
1.15 andrew 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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>