===================================================================
RCS file: /cvs/openbsd/OpenBSDTorrents/ServerTorrents.pl,v
retrieving revision 1.20
retrieving revision 1.28
diff -u -r1.20 -r1.28
--- openbsd/OpenBSDTorrents/ServerTorrents.pl	2005/06/03 02:32:40	1.20
+++ openbsd/OpenBSDTorrents/ServerTorrents.pl	2010/01/07 18:50:02	1.28
@@ -1,208 +1,222 @@
 #!/usr/bin/perl -T
-#$Id: ServerTorrents.pl,v 1.20 2005/06/03 01:32:40 andrew Exp $
+#$RedRiver: ServerTorrents.pl,v 1.27 2008/12/29 22:04:00 andrew Exp $
 use strict;
 use warnings;
 use diagnostics;
 
 use LWP::UserAgent;
 use Time::Local;
+use File::Basename;
 
+#use YAML;
+
 use lib 'lib';
 use OpenBSDTorrents;
 use BT::MetaInfo::Cached;
 
 %ENV = ();
 
-#use YAML;
-
 justme();
 
-my @Sizes = ('', 'Ki', 'Mi', 'Gi', 'Ti');
+my @Sizes = ( '', 'Ki', 'Mi', 'Gi', 'Ti' );
 my $ua = LWP::UserAgent->new;
 
-my $response = $ua->get($OBT->{URL_TORRENTS});
+my $response = $ua->get( $OBT->{URL_TORRENTS} );
 
 my %server_torrents;
-if ($response->is_success) {
-    my $content = $response->content;  # or whatever
-    $content =~ s/^.*<!-- BEGIN LIST -->//s || die "Beginning of list not found!";
-    $content =~ s/<!-- END LIST -->.*$//s   || die "End of list not found!";
-    unless ($content =~ /No data/) {
-        foreach (split /\n/, $content) {
+if ( $response->is_success ) {
+    my $content = $response->content;    # or whatever
+    $content =~ s/^.*<!-- BEGIN LIST -->//s
+        || die "Beginning of list not found!";
+    $content =~ s/<!-- END LIST -->.*$//s || die "End of list not found!";
+    unless ( $content =~ /No data/ ) {
+        foreach ( split /\n/, $content ) {
             s/^\s+//;
             s/\s+$//;
             next unless $_;
-            my ($name, $hash, $disabled) = split /\t/;
+            my ( $name, $hash, $disabled ) = split /\t/;
             next if $name eq 'File';
 
-            $name =~ s#^/torrents/##;
-            $server_torrents{$name}{$hash} = $disabled;
+            $name =~ s#.*/##;
+            $server_torrents{$hash} = {
+                name     => $name,
+                disabled => $disabled,
+            };
         }
     }
-} else {
+}
+else {
     die $response->status_line;
 }
 
+my %torrents;
+opendir DIR, $OBT->{DIR_TORRENT}
+    or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
+foreach my $torrent ( readdir DIR ) {
+    chomp $torrent;
+    next unless $torrent =~ /\.torrent$/;
 
-my %files;
-opendir DIR, $OBT->{DIR_TORRENT} or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
-foreach (readdir DIR) {
-	chomp;
-	if (/^([^\/]+)$/) {
-		$_ = $1;
-	} else {
-		die "Invalid character in $_: $!";
-	}
-	next unless /\.torrent$/;
-	my ($name, $year, $mon, $mday, $hour, $min) = 
-	   /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
+    if ($torrent =~ /^([^\/]+)$/) {
+        $torrent = $1;
+    }
+    else {
+        die "Invalid character in $torrent: $!";
+    }
 
-	my $t;
-        eval {
-		$t = BT::MetaInfo::Cached->new(
-			$OBT->{DIR_TORRENT} . '/' . $_,
-			{
-				cache_root =>
-				$OBT->{DIR_HOME} . '/FileCache'
-			}
-		);
-	};
+    my $name = basename( $torrent, '.torrent' );
 
-	if ($@) {
-		warn "Error reading torrent $_\n";
-		next;
-	}
+    if ( my ( $base, $year, $mon, $mday, $hour, $min )
+        = $torrent =~ /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
+    {
+        $name = $base;
+    }
 
-	my $epoch = $t->creation_date;
+    my $t;
+    eval {
+        $t = BT::MetaInfo::Cached->new(
+            $OBT->{DIR_TORRENT} . '/' . $torrent,
+            {   cache_root => '/tmp/OBTFileCache'
 
-	$files{$name}{$epoch} = {
-		file      => $_,
-		details   => $t,
-		name      => $name,
-		epoch     => $epoch,
-	};
+                    #$OBT->{DIR_HOME} . '/FileCache'
+            }
+        );
+    };
+    if ($@) {
+        warn "Error reading torrent $torrent\n";
+        next;
+    }
 
+    #my $epoch = $t->creation_date;
+
+    my $hash = unpack( "H*", $t->info_hash );
+    $torrents{$hash} = {
+        file    => $torrent,
+        details => $t,
+        name    => $name,
+        #epoch   => $epoch,
+    };
+
+    if ( !exists $server_torrents{$hash} ) {
+        Upload_Torrent( $torrents{$hash} );
+    }
 }
 closedir DIR;
 
-#use Data::Dumper;
-#print Dumper \%server_torrents;#, \%files;
+#print Dump \%server_torrents;
 #exit;
 
-my %torrents;
-FILE: foreach my $name (keys %files) {
-	#print "$name\n";
-	foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
-		#print "\t$epoch\n";
-		my $torrent = $files{$name}{$epoch}{file};
+foreach my $hash ( keys %server_torrents ) {
 
-		my $hash = $files{$name}{$epoch}{'details'}->info_hash;
-		$hash = unpack("H*", $hash);
+    #printf "SERVER: [%s] [%s]\n", $hash, $torrent;
+    if (   ( !exists $torrents{$hash} )
+        && ( !$server_torrents{$hash}{disabled} ) )
+    {
+        Delete_Torrent( $server_torrents{$hash}{name}, $hash );
+    }
+}
 
-		$torrents{$torrent}{$hash} = $files{$name}{$epoch};
+$ua->get( $OBT->{URL_SANITY} );
 
-		unless (exists $server_torrents{$torrent}{$hash}) {
-			Upload_Torrent($files{$name}{$epoch});
-		}
-	}
-}
+sub Upload_Torrent {
+    my $torrent = shift;
+    my $t       = $torrent->{'details'};
 
-foreach my $torrent (keys %server_torrents) {
-	foreach my $hash (keys %{ $server_torrents{$torrent} }) {
-		unless (
-			exists $torrents{$torrent}{$hash} ||
-			$server_torrents{$torrent}{$hash} == 1
-		) {
-			Delete_Torrent($torrent, $hash);
-		}
-	}
-}
+    my $file = $torrent->{'file'};
+    print "Uploading $file\n";
 
-$ua->get($OBT->{URL_SANITY});
+    my $size = $t->total_size;
+    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday )
+        = gmtime( $t->creation_date );
+    $year += 1900;
+    $mon++;
+    my $time = sprintf "%04d.%02d.%02d %02d:%02d",
+        $year, $mon, $mday, $hour, $min;
 
-sub Upload_Torrent
-{
-	my $torrent = shift;
-	my $t = $torrent->{'details'};
+    ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday )
+        = localtime( $t->creation_date );
+    $year += 1900;
+    $mon++;
+    my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d",
+        $year, $mon, $mday, $hour, $min;
 
-	my $file = $torrent->{'file'};
-	print "Uploading $file\n";
+    my $i = 0;
+    while ( $size > 1024 ) {
+        $size /= 1024;
+        $i++;
+    }
+    $size = sprintf( '%.2f', $size );
+    $size .= $Sizes[$i] . 'B';
 
-	my $size = $t->total_size;
-	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
-		gmtime($t->creation_date);
-	$year += 1900;
-	$mon++;
-	my $time = sprintf "%04d.%02d.%02d %02d:%02d", 
-		$year, $mon, $mday,  $hour, $min;
+    my $comment = $t->{comment};
+    $comment =~ s/\n.*$//s;
 
-	($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
-		localtime($t->creation_date);
-	$year += 1900;
-	$mon++;
-	my $sql_time = sprintf "%04d-%02d-%02d %02d:%02d", 
-		$year, $mon, $mday,  $hour, $min;
+    my $filename
+        = $comment =~ /($OBT->{BASENAME}.+)/
+        ? $1
+        : $file;
+    $filename =~ s#/# #g;
+    $filename =~ s/\.torrent\z//;
 
-	my $i = 0;
-	while ($size > 1024) {
-		$size /= 1024;
-		$i++;
-	}
-	$size = sprintf('%.2f', $size);
-	$size .= $Sizes[$i] . 'B';
-	
-	my $comment = $t->{comment};
-	$comment =~ s/\n.*$//s;
-	
-	my ($filename) = $comment =~ /Files from (.+)/;
-	$filename =~ s#/# #g;
-	
-	$comment  .= " [$size]";
-	$filename .= " [$time]";
+    $comment  .= " [$size]";
+    $filename .= " [$time]";
 
-	my $response = $ua->post($OBT->{URL_UPLOAD}, {
-		username => $OBT->{UPLOAD_USER},
-		password => $OBT->{UPLOAD_PASS},
-		torrent  => [ $OBT->{DIR_TORRENT} . "/$file" ],
-		url      => "/torrents/$file",
-		filename => $filename,
-		filedate => $sql_time,
-		info     => $comment,
-		hash     => '',
-		autoset  => 'enabled', # -> checked="checked"
-	}, Content_Type => 'form-data');
+    my $response = $ua->post(
+        $OBT->{URL_UPLOAD},
+        {   username => $OBT->{UPLOAD_USER},
+            password => $OBT->{UPLOAD_PASS},
+            torrent  => [ $OBT->{DIR_TORRENT} . "/$file" ],
+            url      => "/torrents/$file",
+            filename => $filename,
+            filedate => $sql_time,
+            info     => $comment,
+            hash     => '',
+            autoset => 'enabled',    # -> checked="checked"
+        },
+        Content_Type => 'form-data'
+    );
 
-	if ($response->is_success) {
-		print STDERR "Uploaded  $file\n";
-		#print $response->content;
-	} else {
-    		die $response->status_line;
-	}
+    if ( $response->is_success ) {
+        print STDERR "Uploaded  $file\n";
+
+        #print $response->content;
+    }
+    else {
+        die $response->status_line;
+    }
 }
 
-sub Delete_Torrent
-{
-	my $filename = shift;
-	my $hash = shift;
-	die "No hash passed!" unless $hash;
+sub Delete_Torrent {
+    my $filename = shift;
+    my $hash     = shift;
+    die "No hash passed!" unless $hash;
 
-	print "Disabling $filename\n";
+    print "Removing $filename [$hash]\n";
 
-	my $response = $ua->post($OBT->{'URL_DELETE'}, {
-		username => $OBT->{UPLOAD_USER},
-		password => $OBT->{UPLOAD_PASS},
-		filename => $filename,
-		hash     => $hash,
-	}, Content_Type => 'form-data');
+    my $response = $ua->post(
+        $OBT->{'URL_DELETE'},
+        {   username => $OBT->{UPLOAD_USER},
+            password => $OBT->{UPLOAD_PASS},
+            filename => $filename,
+            hash     => $hash,
+        },
+        Content_Type => 'form-data'
+    );
 
-	if ($response->is_success) {
-		#print $response->content;
-		if ($response->content =~ /Torrent was removed successfully/) {
-			print STDERR "Disabled $filename\n";
-		} else {
-			print STDERR "An error occoured removing $filename\n";
-		}
-	} else {
-    		die $response->status_line;
-	}
+    if ( $response->is_success ) {
+        my ($result) = $response->content =~ /class="error"\>([^<]+)\</;
+
+        if ( $result eq 'Torrent was removed successfully.' ) {
+            print STDERR "Removed $filename [$hash]\n";
+        }
+        elsif ($result) {
+            print STDERR "Error: $result (removing $filename [$hash])\n";
+        }
+        else {
+            print STDERR
+                "An unknown error occurred removing $filename [$hash]\n";
+        }
+    }
+    else {
+        die $response->status_line . " removing $filename [$hash]\n";
+    }
 }