version 1.30, 2010/02/25 18:03:01 |
version 1.32, 2010/03/03 18:13:07 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl -T |
#$RedRiver: CurrentTorrents.pl,v 1.29 2010/01/08 17:18:35 andrew Exp $ |
#$RedRiver: CurrentTorrents.pl,v 1.31 2010/02/26 22:58:20 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use diagnostics; |
use diagnostics; |
|
|
if ( $name =~ m/\A $OBT->{BASENAME} /xms |
if ( $name =~ m/\A $OBT->{BASENAME} /xms |
&& !exists $Possible_Torrents{$name} ) |
&& !exists $Possible_Torrents{$name} ) |
{ |
{ |
print "Would remove $_\n"; |
#print "Would remove $_\n"; |
push @delete, $files{$ext}{$name}{$epoch}; |
push @delete, $files{$ext}{$name}{$epoch}; |
} |
} |
} |
} |
|
|
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 !~ /songs/xms; |
#next if $name =~ /_packages_/xms; |
#next if $name =~ /_packages_/xms; |
#print "Checking $name\n"; |
#print "Checking $name\n"; |
|
|
my $cn = $files{torrent}{$name}; |
my $cn = $files{torrent}{$name}; |
|
|
EPOCH: foreach my $epoch ( sort { $a <=> $b } keys %{$cn} ) { |
EPOCH: foreach my $epoch ( sort { $b <=> $a } keys %{$cn} ) { |
my $ct = $cn->{$epoch}; |
my $ct = $cn->{$epoch}; |
my $cf = $ct->{path}; |
my $cf = $ct->{path}; |
|
|
|
|
if ($@) { |
if ($@) { |
warn "Error reading torrent $cf\n"; |
warn "Error reading torrent $cf\n"; |
push @delete, $ct; |
push @delete, $ct; |
delete $cn->{$epoch}; |
|
next EPOCH; |
next EPOCH; |
} |
} |
|
|
|
|
$cn->{$epoch}{file}, ' the path (', $path, |
$cn->{$epoch}{file}, ' the path (', $path, |
") doesn't exist.\n"; |
") doesn't exist.\n"; |
push @delete, $ct; |
push @delete, $ct; |
delete $cn->{$epoch}; |
|
next EPOCH; |
next EPOCH; |
} |
} |
|
|
|
|
undef $t; |
undef $t; |
|
|
if ( $seen{$name} && $seen{$name} ne $hash ) { |
if ( $seen{$name} && $seen{$name} ne $hash ) { |
print "Removing older [$name] [$hash]\n"; |
print "Removing older [$name] [$hash]\n\t", |
if ( $keep{$hash}{path} ) { |
$ct->{path}, |
print "\t", $keep{$hash}{path}, "\n"; |
"\n"; |
} |
$ct->{reason} = 'older'; |
push @delete, $ct; |
push @delete, $ct; |
delete $cn->{$epoch}; |
|
next EPOCH; |
next EPOCH; |
} |
} |
$seen{$name} = $hash; |
elsif ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) { |
|
$ct->{reason} = 'only'; |
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} ) { |
elsif ( $keep{$hash} ) { |
if ( $keep{$hash}{epoch} == $epoch ) { |
if ( $keep{$hash}{epoch} == $epoch ) { |
|
|
|
|
print "Removing duplicate [$name] [$hash]\n\t", |
print "Removing duplicate [$name] [$hash]\n\t", |
$keep{$hash}{path}, "\n"; |
$keep{$hash}{path}, "\n"; |
push @delete, $keep{$hash}; |
|
delete $files{torrent}{ $keep{$hash}{name} } |
|
{ $keep{$hash}{epoch} }; |
|
|
|
$keep{$hash} = $ct; |
$keep{$hash}{reason} = 'duplicate'; |
print "Keeping additional instance of [$name] [$hash]\n\t", |
$ct->{reason} = 'duplicate'; |
$ct->{path}, |
|
"\n"; |
push @delete, $keep{$hash}; |
} |
} |
else { |
else { |
$keep{$hash} = $ct; |
$ct->{reason} = 'first'; |
print "Keeping first instance of [$name] [$hash]\n\t", |
|
$ct->{path}, |
|
"\n"; |
|
|
|
} |
} |
|
|
|
$keep{$hash} = $ct; |
|
$seen{$name} = $hash; |
} |
} |
} |
} |
|
|
#print Dump \%files, \%keep, \@delete; |
#print Dump \%files, \%keep, \@delete; |
|
#print Dump \%keep, \@delete; |
#exit; |
#exit; |
|
|
my $client = Transmission::Client->new; |
my $client = Transmission::Client->new; |
|
|
foreach my $hash ( keys %keep ) { |
foreach my $hash ( keys %keep ) { |
my $file = $keep{$hash}{file} || q{}; |
my $file = $keep{$hash}{file} || q{}; |
my $dir = $keep{$hash}{dir} || q{}; |
my $dir = $keep{$hash}{dir} || q{}; |
|
|
|
my $name = $keep{$hash}{name}; |
|
my $epoch = $keep{$hash}{epoch}; |
|
my $reason = $keep{$hash}{reason}; |
|
|
|
#if ($reason && $reason ne 'only') { |
|
# print "Keeping $reason instance of [$file] [$hash]\n", |
|
# "\t", $file, "\n"; |
|
#} |
|
|
if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) { |
if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) { |
print "Moving $file to current torrents\n"; |
print "Moving $file to current torrents\n"; |
rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file ) |
rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file ) |
or die "Couldn't rename '$file': $!"; |
or die "Couldn't rename '$file': $!"; |
|
|
my $name = $keep{$hash}{name}; |
|
my $epoch = $keep{$hash}{epoch}; |
|
$dir = $OBT->{DIR_TORRENT}; |
$dir = $OBT->{DIR_TORRENT}; |
|
|
if ( exists $files{txt}{$name}{$epoch} ) { |
if ( exists $files{txt}{$name}{$epoch} ) { |
|
|
#warn $client->error, ": $dir/$file\n"; |
#warn $client->error, ": $dir/$file\n"; |
print "Removing invalid torrent\n\t", $keep{$hash}{path}, "\n"; |
print "Removing invalid torrent\n\t", $keep{$hash}{path}, "\n"; |
push @delete, $keep{$hash}; |
push @delete, $keep{$hash}; |
delete $files{torrent}{ $keep{$hash}{name} } |
|
{ $keep{$hash}{epoch} }; |
|
} |
} |
} |
} |
} |
} |
|
|
if ( $_->{path} ) { |
if ( $_->{path} ) { |
print "Deleting '$_->{path}'\n"; |
print "Deleting '$_->{path}'\n"; |
unlink $_->{path} or die "Couldn't unlink $_->{path}"; |
unlink $_->{path} or die "Couldn't unlink $_->{path}"; |
|
delete $files{torrent}{ $_->{name} }{ $_->{epoch} }; |
} |
} |
else { |
else { |
use Data::Dumper; |
use Data::Dumper; |
|
|
if (@$files) { |
if (@$files) { |
my $dir = $basedir; |
my $dir = $basedir; |
$dir =~ s/^$OBT->{DIR_FTP}\///; |
$dir =~ s/^$OBT->{DIR_FTP}\///; |
my $torrent = Name_Torrent($dir); |
Make_Possible($dir); |
$torrent =~ s/-.*$//; |
|
$Possible_Torrents{$torrent} = 1; |
|
foreach my $file (@$files) { |
foreach my $file (@$files) { |
if ( $file =~ /$INSTALL_ISO_REGEX/ ) { |
if ( $file =~ /$INSTALL_ISO_REGEX/ ) { |
$torrent = Name_Torrent("$dir/$file"); |
Make_Possible("$dir/$file"); |
$torrent =~ s/-.*$//; |
|
$Possible_Torrents{$torrent} = 1; |
|
} |
} |
} |
} |
} |
} |
|
|
} |
} |
} |
} |
|
|
|
sub Make_Possible { |
|
my ($path) = @_; |
|
|
|
my $torrent = Name_Torrent($path); |
|
$torrent =~ s/-.*$//; |
|
$Possible_Torrents{$torrent} = 1; |
|
|
|
return $torrent; |
|
} |