| version 1.20, 2005/06/01 19:01:46 |
version 1.25, 2008/11/14 18:18:31 |
|
|
| #!/usr/bin/perl -T |
#!/usr/bin/perl -T |
| #$Id$ |
#$RedRiver: CurrentTorrents.pl,v 1.24 2007/11/02 02:36:01 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; |
|
|
| |
|
| %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}; |
| } |
} |
|
|
| closedir DIR; |
closedir DIR; |
| } |
} |
| |
|
| |
#print Dump \%files; |
| 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"; |
|
|
| $files{torrent}{$name}{$epoch}{dir} |
$files{torrent}{$name}{$epoch}{dir} |
| eq $OBT->{DIR_TORRENT} |
eq $OBT->{DIR_TORRENT} |
| ) { |
) { |
| #print "Skipping torrent for $name there is only one.\n"; |
print "Skipping torrent for $name there is only one.\n"; |
| next; |
next; |
| } |
} |
| |
|
|
|
| $t = BT::MetaInfo::Cached->new( |
$t = BT::MetaInfo::Cached->new( |
| $torrent, |
$torrent, |
| { |
{ |
| cache_root => |
cache_root => '/tmp/OBTFileCache' |
| $OBT->{DIR_HOME} . '/FileCache' |
#$OBT->{DIR_HOME} . '/FileCache' |
| } |
} |
| ); |
); |
| }; |
}; |
| |
|
| if ($@) { |
if ($@) { |
| warn "Error reading torrent $torrent\n"; |
warn "Error reading torrent $torrent\n"; |
| |
push @delete, $files{torrent}{$name}{$epoch}; |
| |
delete $files{torrent}{$name}{$epoch}; |
| next; |
next; |
| } |
} |
| |
|
| $files{torrent}{$name}{$epoch}{comment} = $t->{comment}; |
$files{torrent}{$name}{$epoch}{comment} = $t->{comment}; |
| my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s; |
my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s; |
| |
|
| unless (-d $OBT->{DIR_FTP} . "/$path") { |
unless (-e $OBT->{DIR_FTP} . "/$path") { |
| #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n"; |
print "Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n"; |
| push @delete, $files{torrent}{$name}{$epoch}; |
push @delete, $files{torrent}{$name}{$epoch}; |
| delete $files{torrent}{$name}{$epoch}; |
delete $files{torrent}{$name}{$epoch}; |
| next; |
next; |
|
|
| |
|
| if (exists $keep{$name}) { |
if (exists $keep{$name}) { |
| if (exists $keep{$name}{$hash}) { |
if (exists $keep{$name}{$hash}) { |
| |
if ( $keep{$name}{$hash}{epoch} == $epoch ) { |
| |
next; |
| |
} |
| |
print "Removing [$name] [$hash]\n\t", |
| |
$keep{$name}{$hash}{path}, |
| |
"\n"; |
| push @delete, $keep{$name}{$hash}; |
push @delete, $keep{$name}{$hash}; |
| delete $files{torrent}{ |
delete $files{torrent}{ |
| $keep{$name}{$hash}{name} |
$keep{$name}{$hash}{name} |
|
|
| }; |
}; |
| $keep{$name}{$hash} = |
$keep{$name}{$hash} = |
| $files{torrent}{$name}{$epoch}; |
$files{torrent}{$name}{$epoch}; |
| |
print "Keeping additional instance of [$name] [$hash]\n\t", |
| |
$keep{$name}{$hash}{path}, |
| |
"\n"; |
| } else { |
} else { |
| |
print "Removing old [$name] [$hash]\n\t", |
| |
$keep{$name}{$hash}{path}, |
| |
"\n"; |
| push @delete, $files{torrent}{$name}{$epoch}; |
push @delete, $files{torrent}{$name}{$epoch}; |
| delete $files{torrent}{$name}{$epoch}; |
delete $files{torrent}{$name}{$epoch}; |
| } |
} |
| } else { |
} else { |
| |
print "Keeping first instance of $name [$hash]\n\t", |
| |
$files{torrent}{$name}{$epoch}{path}, |
| |
"\n"; |
| $keep{$name}{$hash} = |
$keep{$name}{$hash} = |
| $files{torrent}{$name}{$epoch}; |
$files{torrent}{$name}{$epoch}; |
| |
|
|
|
| } |
} |
| |
|
| #print Dump \%files, \%keep, \@delete; |
#print Dump \%files, \%keep, \@delete; |
| |
#exit; |
| |
|
| foreach (@delete) { |
foreach (@delete) { |
| print "Deleting '$_->{path}'\n"; |
print "Deleting '$_->{path}'\n"; |
|
|
| my $torrent = Name_Torrent($dir); |
my $torrent = Name_Torrent($dir); |
| $torrent =~ s/-.*$//; |
$torrent =~ s/-.*$//; |
| $Possible_Torrents{$torrent} = 1; |
$Possible_Torrents{$torrent} = 1; |
| |
foreach my $file (@$files) { |
| |
if ($file =~ /$INSTALL_ISO_REGEX/) { |
| |
$torrent = Name_Torrent("$dir/$file"); |
| |
$torrent =~ s/-.*$//; |
| |
$Possible_Torrents{$torrent} = 1; |
| |
} |
| |
} |
| } |
} |
| |
|
| foreach my $subdir (@$dirs) { |
foreach my $subdir (@$dirs) { |