===================================================================
RCS file: /cvs/openbsd/OpenBSDTorrents/CurrentTorrents.pl,v
retrieving revision 1.11
retrieving revision 1.35
diff -u -r1.11 -r1.35
--- openbsd/OpenBSDTorrents/CurrentTorrents.pl	2005/04/07 00:04:40	1.11
+++ openbsd/OpenBSDTorrents/CurrentTorrents.pl	2010/03/08 20:19:35	1.35
@@ -1,107 +1,295 @@
 #!/usr/bin/perl -T
-#$Id: CurrentTorrents.pl,v 1.11 2005/04/06 23:04:40 andrew Exp $
+#$RedRiver: CurrentTorrents.pl,v 1.34 2010/03/03 18:31:57 andrew Exp $
 use strict;
 use warnings;
 use diagnostics;
 
-use BT::MetaInfo;
 use Time::Local;
+use Fcntl ':flock';
+use File::Basename;
 
+use Transmission::Client;
+use Transmission::Utils;
+
+#use YAML;
+
 use lib 'lib';
 use OpenBSDTorrents;
+use BT::MetaInfo::Cached;
 
 %ENV = ();
 
-#use YAML;
+#justme();
 
-justme();
+my $Name_Filter = shift || '';
+if ( $Name_Filter =~ /^(\w*)$/ ) {
+    $Name_Filter = $1;
+}
+else {
+    die "Invalid filter: $Name_Filter";
+}
 
+my %Possible_Torrents;
+Process_Dir( $OBT->{DIR_FTP} );
+
 my %files;
-opendir DIR, $OBT->{DIR_TORRENT} 
-	or die "Couldn't opendir $OBT->{DIR_TORRENT}: $!";
-foreach (readdir DIR) {
-	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})/;
+my @delete;
+foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
+    opendir DIR, $DIR
+        or die "Couldn't opendir $DIR: $!";
+    foreach ( readdir DIR ) {
+        next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
 
-	$mon--;
-	my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
+        if (/^([^\/]+)$/) {
+            $_ = $1;
+        }
+        else {
+            die "Invalid character in $_: $!";
+        }
+        my $epoch = 0;
+        my $name = basename( $_, '.torrent' );
 
-	#print "Adding $_\n";
+        if ( my ( $base, $year, $mon, $mday, $hour, $min )
+            = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
+        {
 
-	$files{$name}{$epoch} = {
-		file      => $_,
-		year      => $year,
-		mon       => $mon,
-		mday      => $mday,
-		hour      => $hour,
-		min       => $min,
-		epoch     => $epoch,
-	};
+            $mon--;
+            $epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
+            $name = $base;
+        }
 
+        #print "Adding $_\n";
+
+        $files{$ext}{$name}{$epoch} = {
+            file => $_,
+            dir  => $DIR,
+            #path => "$DIR/$_",
+            ext  => $ext,
+
+            #year      => $year,
+            #mon       => $mon,
+            #mday      => $mday,
+            #hour      => $hour,
+            #min       => $min,
+            name  => $name,
+            epoch => $epoch,
+        };
+
+        if ( $name =~ m/\A $OBT->{BASENAME} /xms
+            && !exists $Possible_Torrents{$name} )
+        {
+            #print "Would remove $_\n";
+            push @delete, $files{$ext}{$name}{$epoch};
+        }
+    }
+    closedir DIR;
 }
-closedir DIR;
 
+#print Dump \%files;
+
 my %keep;
-my @delete;
-foreach my $name (keys %files) {
-	#print "$name\n";
+my %seen;
+foreach my $name ( sort keys %{ $files{torrent} } ) {
+    next unless $name =~ /^$Name_Filter/;
 
-	foreach my $epoch ( sort { $b <=> $a } keys %{ $files{$name} } ) {
-		#print "\t$epoch\n";
-		my $torrent = $files{$name}{$epoch}{file};
+    #next if $name !~ /songs/xms;
+    #next if $name =~ /_packages_/xms;
+    #print "Checking $name\n";
 
-		my $t;
-		eval { $t = BT::MetaInfo->new($OBT->{DIR_TORRENT} . "/$torrent"); };
-		if ($@) {
-			warn "Error reading torrent $torrent\n";
-			next;
-		}
+    my $cn = $files{torrent}{$name};
 
-		$files{$name}{$epoch}{comment}   = $t->{comment};
-		my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
+EPOCH: foreach my $epoch ( sort { $b <=> $a } keys %{$cn} ) {
+        my $ct = $cn->{$epoch};
+        my $cf = $ct->{dir} . '/' . $ct->{file};
 
-		unless (-d $OBT->{DIR_FTP} . "/$path") {
-			#print "Deleting $files{$name}{$epoch}{file} the path doesn't exist.\n"; 
-			push @delete, $files{$name}{$epoch}{file};
-		}
+        #print "\t$epoch - $cf\n";
 
-		if (keys %{ $files{$name} } == 1) {
-			#print "Skipping torrent for $name there is only one.\n";
-			next;
-		}
+        my $t;
+        eval {
+            $t
+                = BT::MetaInfo::Cached->new( $cf,
+                { cache_root => '/tmp/OBTFileCache' } );
+        };
 
-		my $hash = $t->info_hash;
-		$hash = unpack("H*", $hash);
+        if ($@) {
+            warn "Error reading torrent $cf\n";
+            push @delete, $ct;
+            next EPOCH;
+        }
 
-		$files{$name}{$epoch}{info_hash} = $hash;
+        $ct->{comment} = $t->{comment};
+        my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
 
-		undef $t;
+        if ( !-e $OBT->{DIR_FTP} . "/$path" ) {
+            print
+                'Deleting ',
+                $cn->{$epoch}{file}, ' the path (', $path,
+                ") doesn't exist.\n";
+            push @delete, $ct;
+            next EPOCH;
+        }
 
-		if (exists $keep{$name}) {
-			if (exists $keep{$name}{$hash}) {
-				push @delete, $keep{$name}{$hash};
-				$keep{$name}{$hash} = 
-					$files{$name}{$epoch}{file};
-			} else {
-				push @delete, $files{$name}{$epoch}{file};
-			}
-		} else { 
-			$keep{$name}{$hash} = 
-				$files{$name}{$epoch}{file};
+        my $hash = unpack( "H*", $t->info_hash );
+        $ct->{info_hash} = $hash;
 
-		}
-	}
+        undef $t;
+
+        if ( $seen{$name} && $seen{$name} ne $hash ) {
+            print "Removing older [$name] [$hash]\n\t",
+                $cf,
+                "\n";
+            $ct->{reason} = 'older';
+            push @delete, $ct;
+            next EPOCH;
+        }
+        elsif ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) {
+            $ct->{reason} = 'only';
+        }
+        elsif ( $keep{$hash} ) {
+            if ( $keep{$hash}{epoch} == $epoch ) {
+                next EPOCH;
+            }
+
+            print "Removing duplicate [$name] [$hash]\n\t",
+                $keep{$hash}{file}, "\n";
+
+            $keep{$hash}{reason} = 'duplicate';
+            $ct->{reason} = 'duplicate';
+
+            push @delete, $keep{$hash};
+        }
+        else {
+            $ct->{reason} = 'first';
+        }
+
+        $keep{$hash} = $ct;
+        $seen{$name} = $hash;
+    }
 }
 
 #print Dump \%files, \%keep, \@delete;
+#print Dump \%keep, \@delete;
+#exit;
 
+my $client = Transmission::Client->new;
+my %seeding;
+foreach my $torrent ( @{ $client->torrents } ) {
+
+    #my $status = Transmission::Utils::from_numeric_status($torrent->status);
+    my $hash = $torrent->hash_string;
+    if ( exists $keep{$hash} ) {
+        $seeding{$hash} = $torrent;
+    }
+    else {
+        print "No longer seeding [$hash]\n";
+        $torrent->stop or warn $torrent->error_string;
+        $client->remove( $torrent->id ) or warn $client->error;
+    }
+}
+
+#print Dump \%keep;
+foreach my $hash ( keys %keep ) {
+    my $file = $keep{$hash}{file} || q{};
+    my $dir  = $keep{$hash}{dir}  || q{};
+
+    my $name  = $keep{$hash}{name};
+    my $epoch = $keep{$hash}{epoch};
+    my $reason = $keep{$hash}{reason} ? $keep{$hash}{reason} . q{ } : q{};
+
+    #if ($reason && $reason ne 'only') {
+    #    print "Keeping $reason instance of [$file] [$hash]\n",
+    #        "\t", $file, "\n";
+    #}
+
+    if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
+        print "Moving $file to current torrents\n";
+        rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
+            or die "Couldn't rename '$file': $!";
+
+        $dir = $OBT->{DIR_TORRENT};
+	$keep{$hash}{dir} = $dir;
+
+        if ( exists $files{txt}{$name}{$epoch} ) {
+            my $m_file = $files{txt}{$name}{$epoch}{file};
+            my $m_dir  = $files{txt}{$name}{$epoch}{dir};
+            rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )
+                or die "Couldn't rename '$m_file': $!";
+            $files{txt}{$name}{$epoch}{dir} = $OBT->{DIR_TORRENT};
+        }
+    }
+
+    if ( !$seeding{$hash} ) {
+        print 'Starting seed of ' . $reason . "[$file] [$hash]\n";
+        if (!$client->add(
+                filename     => "$dir/$file",
+                download_dir => $OBT->{DIR_FTP},
+            )
+            )
+        {
+
+            #warn $client->error, ": $dir/$file\n";
+            print "Removing invalid torrent\n\t", $keep{$hash}{file}, "\n";
+            push @delete, $keep{$hash};
+        }
+    }
+}
+
 foreach (@delete) {
-	print "Deleting '$_'\n";
-	unlink $OBT->{DIR_TORRENT} . "/$_" or die "Couldn't unlink $_";
+    my $path = $_->{dir} . '/' . $_->{file};
+    if ( -e $path ) {
+        print "Deleting '$path'\n";
+        unlink $path or die "Couldn't delete $path";
+        delete $files{torrent}{ $_->{name} }{ $_->{epoch} };
+    }
+    else {
+        use Data::Dumper;
+        print Dumper $_;
+    }
+}
+
+foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
+    foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
+        unless ( exists $files{torrent}{$name}{$epoch} ) {
+            my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{dir}
+                     . '/'
+                     . $files{ $OBT->{META_EXT} }{$name}{$epoch}{file};
+
+            print "Unlinking '$path'\n";
+            unlink $path or die "couldn't unlink '$path': $!";
+        }
+    }
+}
+
+$client->start;
+
+sub Process_Dir {
+    my $basedir = shift;
+
+    my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
+    if (@$files) {
+        my $dir = $basedir;
+        $dir =~ s/^$OBT->{DIR_FTP}\///;
+        Make_Possible($dir);
+        foreach my $file (@$files) {
+            if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
+                Make_Possible("$dir/$file");
+            }
+        }
+    }
+
+    foreach my $subdir (@$dirs) {
+        next if $subdir eq '.';
+        next if $subdir eq '..';
+        Process_Dir("$basedir/$subdir");
+    }
+}
+
+sub Make_Possible {
+    my ($path) = @_;
+
+    my $torrent = Name_Torrent($path);
+    $torrent =~ s/-.*$//;
+    $Possible_Torrents{$torrent} = 1;
+   
+    return $torrent;
 }