| version 1.16, 2005/05/05 02:09:43 |
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 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 || ''; |
|
|
| } 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, |
| }; |
}; |
| |
|
| unless (exists $Possible_Torrents{$name}) { |
if ( |
| |
$name =~ m/\A $OBT->{BASENAME} /xms && |
| |
! 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 (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 $meta_file = $torrent; |
|
| $meta_file =~ s/\.torrent$/.$OBT->{META_EXT}/; |
|
| |
|
| my $hash = undef; |
|
| if (-e $meta_file) { |
|
| #print "Reading meta file: $meta_file\n"; |
|
| open my $meta, $meta_file |
|
| or die "Couldn't open $meta_file: $!"; |
|
| flock($meta, LOCK_SH); |
|
| binmode $meta; |
|
| |
|
| $hash = do { local $/; <$meta> }; |
|
| |
|
| flock($meta, LOCK_UN); |
|
| close $meta; |
|
| } else { |
|
| |
|
| 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; |
| } |
} |
| |
|
| $hash = $t->info_hash_cached($torrent); |
my $hash = $t->info_hash; |
| $hash = unpack("H*", $hash); |
$hash = unpack("H*", $hash); |
| |
|
| undef $t; |
undef $t; |
| |
|
| } |
|
| |
|
| $files{torrent}{$name}{$epoch}{info_hash} = $hash; |
$files{torrent}{$name}{$epoch}{info_hash} = $hash; |
| |
|
| |
|
|
|
| } |
} |
| |
|
| #print Dump \%files, \%keep, \@delete; |
#print Dump \%files, \%keep, \@delete; |
| |
#exit; |
| |
|
| foreach (@delete) { |
foreach (@delete) { |
| print "Deleting '$_->{path}'\n"; |
print "Deleting '$_->{path}'\n"; |