Annotation of openbsd/OpenBSDTorrents/ServerTorrents.pl, Revision 1.1
1.1 ! andrew 1: #!/usr/bin/perl -T
! 2: #$Id$
! 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) {
! 101: unless (exists $files{$file}) {
! 102: Delete_Torrent($file);
! 103: }
! 104: }
! 105:
! 106:
! 107: sub Upload_Torrent
! 108: {
! 109: my $file = shift;
! 110: my $time = shift;
! 111:
! 112: print "Uploading $file\n";
! 113:
! 114: my $t;
! 115: eval { $t = BT::MetaInfo->new("$TorrentDir/$file"); };
! 116: if ($@) {
! 117: warn "Error reading torrent $file\n";
! 118: return undef;
! 119: }
! 120:
! 121: my $comment = $t->{comment};
! 122: $comment =~ s/\n.*$//s;
! 123:
! 124: my ($filename) = $comment =~ /Files from ([^<]+)/;
! 125: $filename =~ s#/# #g;
! 126:
! 127: $filename .= ' (' . $time . ')';
! 128:
! 129: my $response = $ua->post($url_upload, {
! 130: username => $user,
! 131: password => $pass,
! 132: torrent => [ "$TorrentDir/$file" ],
! 133: url => "/torrents/$file",
! 134: filename => $filename,
! 135: filedate => $time,
! 136: info => $comment,
! 137: hash => '',
! 138: autoset => 'enabled', # -> checked="checked"
! 139: }, Content_Type => 'form-data');
! 140:
! 141: if ($response->is_success) {
! 142: print "Uploaded $file\n";
! 143: #print $response->content;
! 144: } else {
! 145: die $response->status_line;
! 146: }
! 147: }
! 148:
! 149: sub Delete_Torrent
! 150: {
! 151: my $file = shift;
! 152: print "Will delete $file soon enough\n";
! 153: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>