Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.2
1.1 andrew 1: #!/usr/bin/perl -T
1.2 ! andrew 2: #$Id: ServerTorrents.pl,v 1.1 2005/03/24 00:22:09 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:
16: use YAML;
17:
18: my $url_torrents = 'http://openbsd.somedomain.net/dumptorrents.php';
19: my $url_upload = 'http://openbsd.somedomain.net/newtorrents.php';
20: my $url_delete = 'http://openbsd.somedomain.net/deltorrents.php';
21:
22: my $user = 'torrentup';
23: my $pass = 'ssapword';
24:
25: my $ua = LWP::UserAgent->new;
26:
27: my $response = $ua->get($url_torrents);
28:
29: my %server_torrents;
30: if ($response->is_success) {
31: my $content = $response->content; # or whatever
32: $content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!";
33: $content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!";
34: unless ($content =~ /No data/) {
35: foreach (split /\n/, $content) {
36: s/^\s+//;
37: s/\s+$//;
38: next unless $_;
39: my ($name, $hash) = split /\t/;
40: next if $name eq 'File';
41:
42: $name =~ s#^/torrents/##;
43: $server_torrents{$name} = $hash;
44: }
45: }
46: } else {
47: die $response->status_line;
48: }
49:
50:
51: my %files;
52: opendir DIR, $TorrentDir or die "Couldn't opendir $TorrentDir: $!";
53: foreach (readdir DIR) {
54: if (/^([^\/]+)$/) {
55: $_ = $1;
56: } else {
57: die "Invalid character in $_: $!";
58: }
59: next unless /\.torrent$/;
60: chomp;
61: my ($name, $year, $mon, $mday, $hour, $min) =
62: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
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,
73: epoch => $epoch,
74: };
75:
76: }
77: closedir DIR;
78:
79: #print Dump \%server_torrents, \%files;
80:
81: foreach my $name (keys %files) {
82: #print "$name\n";
83: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
84: #print "\t$epoch\n";
85: my $torrent = $files{$name}{$epoch}{file};
86: unless (exists $server_torrents{$torrent} ) {
87: my $time =
88: $files{$name}{$epoch}{year} . '-' .
89: $files{$name}{$epoch}{mon} . '-' .
90: $files{$name}{$epoch}{mday} . ' ' .
91: $files{$name}{$epoch}{hour} . ':' .
92: $files{$name}{$epoch}{min} . ':00';
93:
94: Upload_Torrent($torrent, $time);
95: }
96: next;
97: }
98: }
99:
100: foreach my $file (keys %server_torrents) {
1.2 ! andrew 101: my ($name, $year, $mon, $mday, $hour, $min) =
! 102: $file =~
! 103: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
! 104: unless (exists $files{$name}) {
1.1 andrew 105: Delete_Torrent($file);
106: }
107: }
108:
109:
110: sub Upload_Torrent
111: {
112: my $file = shift;
113: my $time = shift;
114:
115: print "Uploading $file\n";
116:
117: my $t;
118: eval { $t = BT::MetaInfo->new("$TorrentDir/$file"); };
119: if ($@) {
120: warn "Error reading torrent $file\n";
121: return undef;
122: }
123:
124: my $comment = $t->{comment};
125: $comment =~ s/\n.*$//s;
126:
127: my ($filename) = $comment =~ /Files from ([^<]+)/;
128: $filename =~ s#/# #g;
129:
130: $filename .= ' (' . $time . ')';
131:
132: my $response = $ua->post($url_upload, {
133: username => $user,
134: password => $pass,
135: torrent => [ "$TorrentDir/$file" ],
136: url => "/torrents/$file",
137: filename => $filename,
138: filedate => $time,
139: info => $comment,
140: hash => '',
141: autoset => 'enabled', # -> checked="checked"
142: }, Content_Type => 'form-data');
143:
144: if ($response->is_success) {
145: print "Uploaded $file\n";
146: #print $response->content;
147: } else {
148: die $response->status_line;
149: }
150: }
151:
152: sub Delete_Torrent
153: {
154: my $file = shift;
155: print "Will delete $file soon enough\n";
156: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>