Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.19
1.1 andrew 1: #!/usr/bin/perl -T
1.19 ! andrew 2: #$Id: ServerTorrents.pl,v 1.18 2005/05/20 17:51:51 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(
1.19 ! andrew 63: $OBT->{DIR_TORRENT} . '/' . $_,
1.17 andrew 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";
1.19 ! andrew 73: next;
1.17 andrew 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};
1.19 ! andrew 95:
! 96: my $hash = $files{$name}{$epoch}{'details'}->info_hash;
! 97: $hash = unpack("H*", $hash);
! 98:
! 99: next if (
! 100: exists $server_torrents{$torrent} &&
! 101: $server_torrents{$torrent} eq $hash
! 102: );
! 103:
! 104: Upload_Torrent($files{$name}{$epoch});
1.1 andrew 105: }
106: }
107:
108: foreach my $file (keys %server_torrents) {
1.2 andrew 109: my ($name, $year, $mon, $mday, $hour, $min) =
110: $file =~
111: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
112: unless (exists $files{$name}) {
1.1 andrew 113: Delete_Torrent($file);
114: }
115: }
116:
1.10 andrew 117: $ua->get($OBT->{URL_SANITY});
1.1 andrew 118:
119: sub Upload_Torrent
120: {
1.17 andrew 121: my $torrent = shift;
122: my $t = $torrent->{'details'};
1.1 andrew 123:
1.17 andrew 124: my $file = $torrent->{'file'};
1.1 andrew 125: print "Uploading $file\n";
126:
1.3 andrew 127: my $size = $t->total_size;
1.17 andrew 128: my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
129: gmtime($t->creation_date);
130: $year += 1900;
131: $mon++;
132: my $time = sprintf "%04d.%02d.%02d %02d:%02d",
133: $year, $mon, $mday, $hour, $min;
1.3 andrew 134:
1.19 ! andrew 135: ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
! 136: localtime($t->creation_date);
! 137: $year += 1900;
! 138: $mon++;
! 139: my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
! 140: $year, $mon, $mday, $hour, $min;
! 141:
1.13 andrew 142: my $i = 0;
1.3 andrew 143: while ($size > 1024) {
144: $size /= 1024;
145: $i++;
146: }
147: $size = sprintf('%.2f', $size);
148: $size .= $Sizes[$i] . 'B';
149:
1.1 andrew 150: my $comment = $t->{comment};
151: $comment =~ s/\n.*$//s;
1.3 andrew 152:
153: my ($filename) = $comment =~ /Files from (.+)/;
1.1 andrew 154: $filename =~ s#/# #g;
155:
1.3 andrew 156: $comment .= " [$size]";
157: $filename .= " [$time]";
1.1 andrew 158:
1.10 andrew 159: my $response = $ua->post($OBT->{URL_UPLOAD}, {
160: username => $OBT->{UPLOAD_USER},
161: password => $OBT->{UPLOAD_PASS},
162: torrent => [ $OBT->{DIR_TORRENT} . "/$file" ],
1.1 andrew 163: url => "/torrents/$file",
164: filename => $filename,
1.19 ! andrew 165: filedate => $sql_time,
1.1 andrew 166: info => $comment,
167: hash => '',
168: autoset => 'enabled', # -> checked="checked"
169: }, Content_Type => 'form-data');
170:
171: if ($response->is_success) {
1.6 andrew 172: print STDERR "Uploaded $file\n";
1.1 andrew 173: #print $response->content;
174: } else {
175: die $response->status_line;
176: }
177: }
178:
179: sub Delete_Torrent
180: {
181: my $file = shift;
182: print "Will delete $file soon enough\n";
183: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ServerTorrents.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / openbsd / OpenBSDTorrents