version 1.13, 2005/05/02 22:43:53 |
version 1.21, 2006/05/15 19:47:04 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl -T |
#$Id$ |
#$RedRiver: CurrentTorrents.pl,v 1.20 2005/06/01 18:01:46 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use diagnostics; |
use diagnostics; |
|
|
use Time::Local; |
use Time::Local; |
|
use Fcntl ':flock'; |
|
|
use lib 'lib'; |
use lib 'lib'; |
use OpenBSDTorrents; |
use OpenBSDTorrents; |
use BT::OBTMetaInfo; |
use BT::MetaInfo::Cached; |
|
|
%ENV = (); |
%ENV = (); |
|
|
use YAML; |
use YAML; |
|
|
justme(); |
#justme(); |
|
|
my $Name_Filter = shift || ''; |
my $Name_Filter = shift || ''; |
if ($Name_Filter =~ /^(\w*)$/) { |
if ($Name_Filter =~ /^(\w*)$/) { |
|
|
die "Invalid filter: $Name_Filter"; |
die "Invalid filter: $Name_Filter"; |
} |
} |
|
|
|
my %Possible_Torrents; |
|
Process_Dir($OBT->{DIR_FTP}); |
|
|
my %files; |
my %files; |
|
my %keep; |
|
my @delete; |
foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) { |
foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) { |
opendir DIR, $DIR |
opendir DIR, $DIR |
or die "Couldn't opendir $DIR: $!"; |
or die "Couldn't opendir $DIR: $!"; |
|
|
epoch => $epoch, |
epoch => $epoch, |
}; |
}; |
|
|
|
unless (exists $Possible_Torrents{$name}) { |
|
print "Would remove $_\n"; |
|
push @delete, $files{$ext}{$name}{$epoch}; |
|
} |
} |
} |
closedir DIR; |
closedir DIR; |
} |
} |
|
|
my %keep; |
|
my @delete; |
|
foreach my $name (keys %{ $files{torrent} }) { |
foreach my $name (keys %{ $files{torrent} }) { |
next unless $name =~ /^$Name_Filter/; |
next unless $name =~ /^$Name_Filter/; |
print "Checking $name\n"; |
print "Checking $name\n"; |
|
|
#print "\t$epoch\n"; |
#print "\t$epoch\n"; |
my $torrent = $files{torrent}{$name}{$epoch}{path}; |
my $torrent = $files{torrent}{$name}{$epoch}{path}; |
|
|
|
if ( |
|
keys %{ $files{torrent}{$name} } == 1 && |
|
$files{torrent}{$name}{$epoch}{dir} |
|
eq $OBT->{DIR_TORRENT} |
|
) { |
|
#print "Skipping torrent for $name there is only one.\n"; |
|
next; |
|
} |
|
|
my $t; |
my $t; |
eval { $t = BT::OBTMetaInfo->new( $torrent ); }; |
eval { |
|
$t = BT::MetaInfo::Cached->new( |
|
$torrent, |
|
{ |
|
cache_root => |
|
$OBT->{DIR_HOME} . '/FileCache' |
|
} |
|
); |
|
}; |
|
|
if ($@) { |
if ($@) { |
warn "Error reading torrent $torrent\n"; |
warn "Error reading torrent $torrent\n"; |
|
|
next; |
next; |
} |
} |
|
|
if ( |
my $hash = $t->info_hash; |
keys %{ $files{torrent}{$name} } == 1 && |
|
$files{torrent}{$name}{$epoch}{dir} |
|
eq $OBT->{DIR_TORRENT} |
|
) { |
|
#print "Skipping torrent for $name there is only one.\n"; |
|
next; |
|
} |
|
|
|
my $hash = $t->info_hash_cached($torrent); |
|
$hash = unpack("H*", $hash); |
$hash = unpack("H*", $hash); |
|
|
|
undef $t; |
|
|
$files{torrent}{$name}{$epoch}{info_hash} = $hash; |
$files{torrent}{$name}{$epoch}{info_hash} = $hash; |
|
|
undef $t; |
|
|
|
if (exists $keep{$name}) { |
if (exists $keep{$name}) { |
if (exists $keep{$name}{$hash}) { |
if (exists $keep{$name}{$hash}) { |
|
|
} |
} |
} |
} |
} |
} |
|
|
|
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 $subdir (@$dirs) { |
|
next if $subdir eq '.'; |
|
next if $subdir eq '..'; |
|
Process_Dir("$basedir/$subdir") |
|
} |
|
} |
|
|