Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.11
1.1 andrew 1: #!/usr/bin/perl -T
1.11 ! andrew 2: #$Id: ServerTorrents.pl,v 1.10 2005/04/06 23:05:28 andrew Exp andrew $
1.1 andrew 3: use strict;
4: use warnings;
5: use diagnostics;
6:
1.11 ! andrew 7: use BT::OBTMetaInfo;
1.1 andrew 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:
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.11 ! andrew 120: eval { $t = BT::OBTMetaInfo->new("$OBT->{DIR_TORRENT}/$file"); };
1.1 andrew 121: if ($@) {
122: warn "Error reading torrent $file\n";
123: return undef;
124: }
125:
1.3 andrew 126: my $size = $t->total_size;
127:
128: my $i;
129: while ($size > 1024) {
130: $size /= 1024;
131: $i++;
132: }
133: $size = sprintf('%.2f', $size);
134: $size .= $Sizes[$i] . 'B';
135:
1.1 andrew 136: my $comment = $t->{comment};
137: $comment =~ s/\n.*$//s;
1.3 andrew 138:
139: my ($filename) = $comment =~ /Files from (.+)/;
1.1 andrew 140: $filename =~ s#/# #g;
141:
1.3 andrew 142: $comment .= " [$size]";
143: $filename .= " [$time]";
1.1 andrew 144:
1.10 andrew 145: my $response = $ua->post($OBT->{URL_UPLOAD}, {
146: username => $OBT->{UPLOAD_USER},
147: password => $OBT->{UPLOAD_PASS},
148: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
1.1 andrew 149: url => "/torrents/$file",
150: filename => $filename,
151: filedate => $time,
152: info => $comment,
153: hash => '',
154: autoset => 'enabled', # -> checked="checked"
155: }, Content_Type => 'form-data');
156:
157: if ($response->is_success) {
1.6 andrew 158: print STDERR "Uploaded $file\n";
1.1 andrew 159: #print $response->content;
160: } else {
161: die $response->status_line;
162: }
163: }
164:
165: sub Delete_Torrent
166: {
167: my $file = shift;
168: print "Will delete $file soon enough\n";
169: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>