version 1.28, 2010/01/05 19:55:22 |
version 1.30, 2010/02/25 18:03:01 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl -T |
#$RedRiver: CurrentTorrents.pl,v 1.26 2009/10/20 19:04:28 andrew Exp $ |
#$RedRiver: CurrentTorrents.pl,v 1.29 2010/01/08 17:18:35 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use diagnostics; |
use diagnostics; |
|
|
use Fcntl ':flock'; |
use Fcntl ':flock'; |
use File::Basename; |
use File::Basename; |
|
|
|
use Transmission::Client; |
|
use Transmission::Utils; |
|
|
#use YAML; |
#use YAML; |
|
|
use lib 'lib'; |
use lib 'lib'; |
|
|
#print Dump \%files; |
#print Dump \%files; |
|
|
my %keep; |
my %keep; |
|
my %seen; |
foreach my $name ( sort keys %{ $files{torrent} } ) { |
foreach my $name ( sort keys %{ $files{torrent} } ) { |
next unless $name =~ /^$Name_Filter/; |
next unless $name =~ /^$Name_Filter/; |
|
|
|
#next if $name =~ /_packages_/xms; |
#print "Checking $name\n"; |
#print "Checking $name\n"; |
|
|
foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) |
my $cn = $files{torrent}{$name}; |
{ |
|
|
|
#print "\t$epoch\n"; |
EPOCH: foreach my $epoch ( sort { $a <=> $b } keys %{$cn} ) { |
my $torrent = $files{torrent}{$name}{$epoch}{path}; |
my $ct = $cn->{$epoch}; |
|
my $cf = $ct->{path}; |
|
|
if ( keys %{ $files{torrent}{$name} } == 1 |
#print "\t$epoch - $cf\n"; |
&& $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 { |
eval { |
$t = BT::MetaInfo::Cached->new( |
$t |
$torrent, |
= BT::MetaInfo::Cached->new( $cf, |
{ cache_root => '/tmp/OBTFileCache' |
{ cache_root => '/tmp/OBTFileCache' } ); |
|
|
#$OBT->{DIR_HOME} . '/FileCache' |
|
} |
|
); |
|
}; |
}; |
|
|
if ($@) { |
if ($@) { |
warn "Error reading torrent $torrent\n"; |
warn "Error reading torrent $cf\n"; |
push @delete, $files{torrent}{$name}{$epoch}; |
push @delete, $ct; |
delete $files{torrent}{$name}{$epoch}; |
delete $cn->{$epoch}; |
next; |
next EPOCH; |
} |
} |
|
|
$files{torrent}{$name}{$epoch}{comment} = $t->{comment}; |
$ct->{comment} = $t->{comment}; |
my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s; |
my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s; |
|
|
unless ( -e $OBT->{DIR_FTP} . "/$path" ) { |
if ( !-e $OBT->{DIR_FTP} . "/$path" ) { |
print |
print |
"Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n"; |
'Deleting ', |
push @delete, $files{torrent}{$name}{$epoch}; |
$cn->{$epoch}{file}, ' the path (', $path, |
delete $files{torrent}{$name}{$epoch}; |
") doesn't exist.\n"; |
next; |
push @delete, $ct; |
|
delete $cn->{$epoch}; |
|
next EPOCH; |
} |
} |
|
|
my $hash = $t->info_hash; |
my $hash = unpack( "H*", $t->info_hash ); |
$hash = unpack( "H*", $hash ); |
$ct->{info_hash} = $hash; |
|
|
undef $t; |
undef $t; |
|
|
$files{torrent}{$name}{$epoch}{info_hash} = $hash; |
if ( $seen{$name} && $seen{$name} ne $hash ) { |
|
print "Removing older [$name] [$hash]\n"; |
|
if ( $keep{$hash}{path} ) { |
|
print "\t", $keep{$hash}{path}, "\n"; |
|
} |
|
push @delete, $ct; |
|
delete $cn->{$epoch}; |
|
next EPOCH; |
|
} |
|
$seen{$name} = $hash; |
|
|
if ( exists $keep{$hash} ) { |
if ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) { |
|
$keep{$hash} = $ct; |
|
|
|
#print "Keeping only instance of [$name] [$hash]\n\t", |
|
# $ct->{path}, |
|
# "\n"; |
|
next EPOCH; |
|
} |
|
elsif ( $keep{$hash} ) { |
if ( $keep{$hash}{epoch} == $epoch ) { |
if ( $keep{$hash}{epoch} == $epoch ) { |
next; |
next EPOCH; |
} |
} |
print "Removing [$name] [$hash]\n\t", $keep{$hash}{path}, "\n"; |
|
|
print "Removing duplicate [$name] [$hash]\n\t", |
|
$keep{$hash}{path}, "\n"; |
push @delete, $keep{$hash}; |
push @delete, $keep{$hash}; |
delete $files{torrent}{ $keep{$hash}{name} } |
delete $files{torrent}{ $keep{$hash}{name} } |
{ $keep{$hash}{epoch} }; |
{ $keep{$hash}{epoch} }; |
$keep{$hash} = $files{torrent}{$name}{$epoch}; |
|
print "Keeping additional instance of [$name] [$hash]\n\t", |
$keep{$hash} = $ct; |
$keep{$hash}{path}, |
print "Keeping additional instance of [$name] [$hash]\n\t", |
|
$ct->{path}, |
"\n"; |
"\n"; |
} |
} |
else { |
else { |
print "Removing old [$name] [$hash]\n"; |
$keep{$hash} = $ct; |
if ( $keep{$hash}{path} ) { |
print "Keeping first instance of [$name] [$hash]\n\t", |
print "\t", $keep{$hash}{path}, "\n"; |
$ct->{path}, |
} |
|
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"; |
"\n"; |
$keep{$hash} = $files{torrent}{$name}{$epoch}; |
|
|
|
} |
} |
} |
} |
|
|
#print Dump \%files, \%keep, \@delete; |
#print Dump \%files, \%keep, \@delete; |
#exit; |
#exit; |
|
|
foreach (@delete) { |
my $client = Transmission::Client->new; |
print "Deleting '$_->{path}'\n"; |
my %seeding; |
unlink $_->{path} or die "Couldn't unlink $_->{path}"; |
foreach my $torrent ( @{ $client->torrents } ) { |
} |
|
|
|
foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) { |
#my $status = Transmission::Utils::from_numeric_status($torrent->status); |
foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) { |
my $hash = $torrent->hash_string; |
unless ( exists $files{torrent}{$name}{$epoch} ) { |
if ( exists $keep{$hash} ) { |
my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path}; |
$seeding{$hash} = $torrent; |
print "Unlinking '$path'\n"; |
|
unlink $path or die "couldn't unlink '$path': $!"; |
|
} |
|
} |
} |
|
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; |
#print Dump \%keep; |
|
|
|
|
my $name = $keep{$hash}{name}; |
my $name = $keep{$hash}{name}; |
my $epoch = $keep{$hash}{epoch}; |
my $epoch = $keep{$hash}{epoch}; |
|
$dir = $OBT->{DIR_TORRENT}; |
|
|
if ( exists $files{txt}{$name}{$epoch} ) { |
if ( exists $files{txt}{$name}{$epoch} ) { |
my $m_file = $files{txt}{$name}{$epoch}{file}; |
my $m_file = $files{txt}{$name}{$epoch}{file}; |
|
|
or die "Couldn't rename '$m_file': $!"; |
or die "Couldn't rename '$m_file': $!"; |
} |
} |
} |
} |
|
|
|
if ( !$seeding{$hash} ) { |
|
print "Starting seed of [$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}{path}, "\n"; |
|
push @delete, $keep{$hash}; |
|
delete $files{torrent}{ $keep{$hash}{name} } |
|
{ $keep{$hash}{epoch} }; |
|
} |
|
} |
} |
} |
|
|
|
foreach (@delete) { |
|
if ( $_->{path} ) { |
|
print "Deleting '$_->{path}'\n"; |
|
unlink $_->{path} or die "Couldn't unlink $_->{path}"; |
|
} |
|
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}{path}; |
|
print "Unlinking '$path'\n"; |
|
unlink $path or die "couldn't unlink '$path': $!"; |
|
} |
|
} |
|
} |
|
|
|
$client->start; |
|
|
sub Process_Dir { |
sub Process_Dir { |
my $basedir = shift; |
my $basedir = shift; |