| version 1.29, 2010/01/08 17:18:35 |
version 1.36, 2010/03/16 23:37:32 |
|
|
| #!/usr/bin/perl -T |
#!/usr/bin/perl -T |
| #$RedRiver: CurrentTorrents.pl,v 1.28 2010/01/05 19:55:22 andrew Exp $ |
#$RedRiver: CurrentTorrents.pl,v 1.35 2010/03/08 20:19:35 andrew Exp $ |
| use strict; |
use strict; |
| use warnings; |
use warnings; |
| use diagnostics; |
use diagnostics; |
|
|
| $name = $base; |
$name = $base; |
| } |
} |
| |
|
| #print "Adding $_\n"; |
#print "Adding $DIR/$_\n"; |
| |
|
| |
if (exists $files{$ext}{$name}{$epoch}) { |
| |
warn "Multiple torrents with $name and epoch $epoch\n"; |
| |
} |
| |
|
| $files{$ext}{$name}{$epoch} = { |
$files{$ext}{$name}{$epoch} = { |
| file => $_, |
file => $_, |
| dir => $DIR, |
dir => $DIR, |
| path => "$DIR/$_", |
#path => "$DIR/$_", |
| ext => $ext, |
ext => $ext, |
| |
|
| #year => $year, |
#year => $year, |
|
|
| 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"; |
| |
|
|
|
| |
|
| EPOCH: foreach my $epoch ( sort { $b <=> $a } 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->{dir} . '/' . $ct->{file}; |
| |
|
| #print "\t$epoch - $cf\n"; |
#print "\t$epoch - $cf\n"; |
| |
|
|
|
| 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} ) { |
$cf, |
| 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}{file}, "\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} ? $keep{$hash}{reason} . q{ } : q{}; |
| |
|
| |
#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}; |
| |
$keep{$hash}{dir} = $dir; |
| |
|
| 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}; |
| my $m_dir = $files{txt}{$name}{$epoch}{dir}; |
my $m_dir = $files{txt}{$name}{$epoch}{dir}; |
| rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file ) |
rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file ) |
| or die "Couldn't rename '$m_file': $!"; |
or die "Couldn't rename '$m_file': $!"; |
| |
$files{txt}{$name}{$epoch}{dir} = $OBT->{DIR_TORRENT}; |
| } |
} |
| } |
} |
| |
|
| if ( !$seeding{$hash} ) { |
if ( !$seeding{$hash} ) { |
| print "Starting seed of [$file] [$hash]\n"; |
print 'Starting seed of ' . $reason . "[$file] [$hash]\n"; |
| if (!$client->add( |
if (!$client->add( |
| filename => "$dir/$file", |
filename => "$dir/$file", |
| download_dir => $OBT->{DIR_FTP}, |
download_dir => $OBT->{DIR_FTP}, |
|
|
| { |
{ |
| |
|
| #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}{file}, "\n"; |
| push @delete, $keep{$hash}; |
push @delete, $keep{$hash}; |
| delete $files{torrent}{ $keep{$hash}{name} } |
|
| { $keep{$hash}{epoch} }; |
|
| } |
} |
| } |
} |
| } |
} |
| |
|
| foreach (@delete) { |
foreach (@delete) { |
| if ( $_->{path} ) { |
my $path = $_->{dir} . '/' . $_->{file}; |
| print "Deleting '$_->{path}'\n"; |
if ( -e $path ) { |
| unlink $_->{path} or die "Couldn't unlink $_->{path}"; |
print "Deleting '$path'\n"; |
| |
unlink $path or die "Couldn't delete $path"; |
| |
delete $files{torrent}{ $_->{name} }{ $_->{epoch} }; |
| } |
} |
| else { |
else { |
| use Data::Dumper; |
use Data::Dumper; |
|
|
| foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) { |
foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) { |
| foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) { |
foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) { |
| unless ( exists $files{torrent}{$name}{$epoch} ) { |
unless ( exists $files{torrent}{$name}{$epoch} ) { |
| my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path}; |
my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{dir} |
| |
. '/' |
| |
. $files{ $OBT->{META_EXT} }{$name}{$epoch}{file}; |
| |
|
| print "Unlinking '$path'\n"; |
print "Unlinking '$path'\n"; |
| unlink $path or die "couldn't unlink '$path': $!"; |
unlink $path or die "couldn't unlink '$path': $!"; |
| } |
} |
|
|
| 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; |
| |
} |