===================================================================
RCS file: /cvs/openbsd/OpenBSDTorrents/CurrentTorrents.pl,v
retrieving revision 1.14
retrieving revision 1.26
diff -u -r1.14 -r1.26
--- openbsd/OpenBSDTorrents/CurrentTorrents.pl	2005/05/04 01:11:59	1.14
+++ openbsd/OpenBSDTorrents/CurrentTorrents.pl	2009/10/20 20:04:28	1.26
@@ -1,21 +1,22 @@
 #!/usr/bin/perl -T
-#$Id: CurrentTorrents.pl,v 1.14 2005/05/04 00:11:59 andrew Exp $
+#$RedRiver: CurrentTorrents.pl,v 1.25 2008/11/14 18:18:31 andrew Exp $
 use strict;
 use warnings;
 use diagnostics;
 
 use Time::Local;
+use Fcntl ':flock';
+use File::Basename;
+#use YAML;
 
 use lib 'lib';
 use OpenBSDTorrents;
-use BT::OBTMetaInfo;
+use BT::MetaInfo::Cached;
 
 %ENV = ();
 
-use YAML;
+#justme();
 
-justme();
-
 my $Name_Filter = shift || '';
 if ($Name_Filter =~ /^(\w*)$/) {
 	$Name_Filter = $1;
@@ -23,7 +24,12 @@
 	die "Invalid filter: $Name_Filter";
 }
 
+my %Possible_Torrents;
+Process_Dir($OBT->{DIR_FTP});
+
 my %files;
+my %keep;
+my @delete;
 foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) {
 	opendir DIR, $DIR 
 		or die "Couldn't opendir $DIR: $!";
@@ -35,12 +41,17 @@
 		} else {
 			die "Invalid character in $_: $!";
 		}
-		my ($name, $year, $mon, $mday, $hour, $min) = 
-		   /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
+		my $epoch = 0;
+		my $name  = basename($_, '.torrent');
 
-		$mon--;
-		my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
+		if (my ($base, $year, $mon, $mday, $hour, $min) = 
+		   /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) {
 
+			$mon--;
+ 			$epoch = timegm(0,$min,$hour,$mday,$mon,$year);
+			$name = $base;
+		}
+
 		#print "Adding $_\n";
 
 		$files{$ext}{$name}{$epoch} = {
@@ -48,24 +59,30 @@
 			dir       => $DIR,
 			path      => "$DIR/$_",
 			ext       => $ext,
-			year      => $year,
-			mon       => $mon,
-			mday      => $mday,
-			hour      => $hour,
-			min       => $min,
+			#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;
 }
 
-my %keep;
-my @delete;
-foreach my $name (keys %{ $files{torrent} }) {
+#print Dump \%files;
+foreach my $name (sort keys %{ $files{torrent} }) {
 	next unless $name =~ /^$Name_Filter/;
-	print "Checking $name\n";
+	#print "Checking $name\n";
 
 	foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {
 		#print "\t$epoch\n";
@@ -80,34 +97,50 @@
 			next;
 		}
 
-
 		my $t;
-		eval { $t = BT::OBTMetaInfo->new( $torrent ); };
+		eval { 
+			$t = BT::MetaInfo::Cached->new( 
+				$torrent, 
+				{ 
+					cache_root => '/tmp/OBTFileCache'
+					#$OBT->{DIR_HOME} . '/FileCache' 
+				}
+			); 
+		};
 
 		if ($@) {
 			warn "Error reading torrent $torrent\n";
+			push @delete, $files{torrent}{$name}{$epoch};
+			delete $files{torrent}{$name}{$epoch};
 			next;
 		}
 
 		$files{torrent}{$name}{$epoch}{comment}   = $t->{comment};
-		my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
+		my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
 
-		unless (-d $OBT->{DIR_FTP} . "/$path") {
-			#print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n"; 
+		unless (-e $OBT->{DIR_FTP} . "/$path") {
+			print "Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n"; 
 			push @delete, $files{torrent}{$name}{$epoch};
 			delete $files{torrent}{$name}{$epoch};
 			next;
 		}
 
-		my $hash = $t->info_hash_cached($torrent);
+		my $hash = $t->info_hash;
 		$hash = unpack("H*", $hash);
 
+		undef $t;
+
 		$files{torrent}{$name}{$epoch}{info_hash} = $hash;
 
-		undef $t;
 
 		if (exists $keep{$name}) {
 			if (exists $keep{$name}{$hash}) {
+				if ( $keep{$name}{$hash}{epoch} == $epoch ) {
+					next;
+				}
+				print "Removing [$name] [$hash]\n\t",
+					 $keep{$name}{$hash}{path},
+					"\n";
 				push @delete, $keep{$name}{$hash};
 				delete $files{torrent}{
 					$keep{$name}{$hash}{name}
@@ -116,11 +149,22 @@
 				};
 				$keep{$name}{$hash} = 
 					$files{torrent}{$name}{$epoch};
+				print "Keeping additional instance of  [$name] [$hash]\n\t",
+					 $keep{$name}{$hash}{path},
+					"\n";
 			} else {
+				print "Removing old [$name] [$hash]\n";
+				if ( $keep{$name}{$hash}{path} ) {
+					print "\t", $keep{$name}{$hash}{path}, 
+						"\n";
+				}
 				push @delete, $files{torrent}{$name}{$epoch};
 				delete $files{torrent}{$name}{$epoch};
 			}
 		} else { 
+			print "Keeping first instance of $name [$hash]\n\t", 
+				$files{torrent}{$name}{$epoch}{path},
+				"\n";
 			$keep{$name}{$hash} = 
 				$files{torrent}{$name}{$epoch};
 
@@ -129,6 +173,7 @@
 }
 
 #print Dump \%files, \%keep, \@delete;
+#exit;
 
 foreach (@delete) {
 	print "Deleting '$_->{path}'\n";
@@ -149,8 +194,8 @@
 #print Dump \%keep;
 foreach my $name (keys %keep) {
 	foreach my $hash (keys %{ $keep{$name} }) {
-		my $file = $keep{$name}{$hash}{file};
-		my $dir  = $keep{$name}{$hash}{dir };
+		my $file = $keep{$name}{$hash}{file} || q{};
+		my $dir  = $keep{$name}{$hash}{dir } || q{};
 		if ($dir eq $OBT->{DIR_NEW_TORRENT}) {
 			print "Moving $file to current torrents\n";
 			rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file)
@@ -170,3 +215,31 @@
 		}
 	}
 }
+
+sub Process_Dir
+{
+        my $basedir = shift;
+
+        my ($dirs, $files) = Get_Files_and_Dirs($basedir);
+        if (@$files) {
+		my $dir = $basedir;
+		$dir =~ s/^$OBT->{DIR_FTP}\///;
+                my $torrent = Name_Torrent($dir);
+		$torrent =~ s/-.*$//;
+		$Possible_Torrents{$torrent} = 1;
+		foreach my $file (@$files) {
+			if ($file =~ /$INSTALL_ISO_REGEX/) {
+				$torrent = Name_Torrent("$dir/$file");
+				$torrent =~ s/-.*$//;
+				$Possible_Torrents{$torrent} = 1;
+			}
+		}
+        }
+
+        foreach my $subdir (@$dirs) {
+                next if $subdir eq '.';
+                next if $subdir eq '..';
+                Process_Dir("$basedir/$subdir")
+        }
+}
+