| version 1.28, 2010/01/05 19:55:22 |
version 1.29, 2010/01/08 17:18:35 |
|
|
| #!/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.28 2010/01/05 19:55:22 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 { $b <=> $a } 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; |