Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.3
1.1 andrew 1: #!/usr/bin/perl -T
1.3 ! andrew 2: #$Id: ServerTorrents.pl,v 1.2 2005/03/24 00:42: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.3 ! andrew 16:
1.1 andrew 17: use YAML;
18:
19: my $url_torrents = 'http://openbsd.somedomain.net/dumptorrents.php';
20: my $url_upload = 'http://openbsd.somedomain.net/newtorrents.php';
21: my $url_delete = 'http://openbsd.somedomain.net/deltorrents.php';
22:
23: my $user = 'torrentup';
24: my $pass = 'ssapword';
25:
1.3 ! andrew 26: my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti');
1.1 andrew 27: my $ua = LWP::UserAgent->new;
28:
29: my $response = $ua->get($url_torrents);
30:
31: my %server_torrents;
32: if ($response->is_success) {
33: my $content = $response->content; # or whatever
34: $content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!";
35: $content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!";
36: unless ($content =~ /No data/) {
37: foreach (split /\n/, $content) {
38: s/^\s+//;
39: s/\s+$//;
40: next unless $_;
41: my ($name, $hash) = split /\t/;
42: next if $name eq 'File';
43:
44: $name =~ s#^/torrents/##;
45: $server_torrents{$name} = $hash;
46: }
47: }
48: } else {
49: die $response->status_line;
50: }
51:
52:
53: my %files;
54: opendir DIR, $TorrentDir or die "Couldn't opendir $TorrentDir: $!";
55: foreach (readdir DIR) {
56: if (/^([^\/]+)$/) {
57: $_ = $1;
58: } else {
59: die "Invalid character in $_: $!";
60: }
61: next unless /\.torrent$/;
62: chomp;
63: my ($name, $year, $mon, $mday, $hour, $min) =
64: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
65:
66: my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
67:
68: $files{$name}{$epoch} = {
69: file => $_,
70: year => $year,
71: mon => $mon,
72: mday => $mday,
73: hour => $hour,
74: min => $min,
75: epoch => $epoch,
76: };
77:
78: }
79: closedir DIR;
80:
81: #print Dump \%server_torrents, \%files;
82:
83: foreach my $name (keys %files) {
84: #print "$name\n";
85: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
86: #print "\t$epoch\n";
87: my $torrent = $files{$name}{$epoch}{file};
88: unless (exists $server_torrents{$torrent} ) {
89: my $time =
90: $files{$name}{$epoch}{year} . '-' .
91: $files{$name}{$epoch}{mon} . '-' .
92: $files{$name}{$epoch}{mday} . ' ' .
93: $files{$name}{$epoch}{hour} . ':' .
94: $files{$name}{$epoch}{min} . ':00';
95:
96: Upload_Torrent($torrent, $time);
97: }
98: next;
99: }
100: }
101:
102: foreach my $file (keys %server_torrents) {
1.2 andrew 103: my ($name, $year, $mon, $mday, $hour, $min) =
104: $file =~
105: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
106: unless (exists $files{$name}) {
1.1 andrew 107: Delete_Torrent($file);
108: }
109: }
110:
111:
112: sub Upload_Torrent
113: {
114: my $file = shift;
115: my $time = shift;
116:
117: print "Uploading $file\n";
118:
119: my $t;
120: eval { $t = BT::MetaInfo->new("$TorrentDir/$file"); };
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:
145: my $response = $ua->post($url_upload, {
146: username => $user,
147: password => $pass,
148: torrent => [ "$TorrentDir/$file" ],
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) {
158: print "Uploaded $file\n";
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>