version 1.14, 2005/05/04 01:11:59 |
version 1.23, 2007/10/01 21:17:23 |
|
|
#!/usr/bin/perl -T |
#!/usr/bin/perl -T |
#$Id$ |
#$RedRiver: CurrentTorrents.pl,v 1.22 2006/07/24 18:03:53 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use diagnostics; |
use diagnostics; |
|
|
use Time::Local; |
use Time::Local; |
|
use Fcntl ':flock'; |
|
use File::Basename; |
|
#use YAML; |
|
|
use lib 'lib'; |
use lib 'lib'; |
use OpenBSDTorrents; |
use OpenBSDTorrents; |
use BT::OBTMetaInfo; |
use BT::MetaInfo::Cached; |
|
|
%ENV = (); |
%ENV = (); |
|
|
use YAML; |
#justme(); |
|
|
justme(); |
|
|
|
my $Name_Filter = shift || ''; |
my $Name_Filter = shift || ''; |
if ($Name_Filter =~ /^(\w*)$/) { |
if ($Name_Filter =~ /^(\w*)$/) { |
$Name_Filter = $1; |
$Name_Filter = $1; |
|
|
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: $!"; |
|
|
} else { |
} else { |
die "Invalid character in $_: $!"; |
die "Invalid character in $_: $!"; |
} |
} |
my ($name, $year, $mon, $mday, $hour, $min) = |
my $epoch = 0; |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/; |
my $name = basename($_, '.torrent'); |
|
|
$mon--; |
if (my ($base, $year, $mon, $mday, $hour, $min) = |
my $epoch = timegm(0,$min,$hour,$mday,$mon,$year); |
/^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/) { |
|
|
|
$mon--; |
|
$epoch = timegm(0,$min,$hour,$mday,$mon,$year); |
|
$name = $base; |
|
} |
|
|
#print "Adding $_\n"; |
#print "Adding $_\n"; |
|
|
$files{$ext}{$name}{$epoch} = { |
$files{$ext}{$name}{$epoch} = { |
|
|
dir => $DIR, |
dir => $DIR, |
path => "$DIR/$_", |
path => "$DIR/$_", |
ext => $ext, |
ext => $ext, |
year => $year, |
#year => $year, |
mon => $mon, |
#mon => $mon, |
mday => $mday, |
#mday => $mday, |
hour => $hour, |
#hour => $hour, |
min => $min, |
#min => $min, |
name => $name, |
name => $name, |
epoch => $epoch, |
epoch => $epoch, |
}; |
}; |
|
|
|
if ( |
|
$name =~ m/\A $OBT->{BASENAME} /xms && |
|
! 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"; |
|
|
foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) { |
foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) { |
#print "\t$epoch\n"; |
#print "\t$epoch\n"; |
|
|
next; |
next; |
} |
} |
|
|
|
|
my $t; |
my $t; |
eval { $t = BT::OBTMetaInfo->new( $torrent ); }; |
eval { |
|
$t = BT::MetaInfo::Cached->new( |
|
$torrent, |
|
{ |
|
cache_root => '/tmp/OBTFileCache' |
|
#$OBT->{DIR_HOME} . '/FileCache' |
|
} |
|
); |
|
}; |
|
|
if ($@) { |
if ($@) { |
warn "Error reading torrent $torrent\n"; |
warn "Error reading torrent $torrent\n"; |
|
|
next; |
next; |
} |
} |
|
|
my $hash = $t->info_hash_cached($torrent); |
my $hash = $t->info_hash; |
$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}) { |
|
|
} |
} |
|
|
#print Dump \%files, \%keep, \@delete; |
#print Dump \%files, \%keep, \@delete; |
|
#exit; |
|
|
foreach (@delete) { |
foreach (@delete) { |
print "Deleting '$_->{path}'\n"; |
print "Deleting '$_->{path}'\n"; |
|
|
} |
} |
} |
} |
} |
} |
|
|
|
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") |
|
} |
|
} |
|
|