#!/usr/bin/perl -T
#$RedRiver: CurrentTorrents.pl,v 1.26 2009/10/20 19:04:28 andrew Exp $
use strict;
use warnings;
use diagnostics;
use Time::Local;
use Fcntl ':flock';
use File::Basename;
#use YAML;
use lib 'lib';
use OpenBSDTorrents;
use BT::MetaInfo::Cached;
%ENV = ();
#justme();
my $Name_Filter = shift || '';
if ( $Name_Filter =~ /^(\w*)$/ ) {
$Name_Filter = $1;
}
else {
die "Invalid filter: $Name_Filter";
}
my %Possible_Torrents;
Process_Dir( $OBT->{DIR_FTP} );
my %files;
my %keep;
my @delete;
foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
opendir DIR, $DIR
or die "Couldn't opendir $DIR: $!";
foreach ( readdir DIR ) {
next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
if (/^([^\/]+)$/) {
$_ = $1;
}
else {
die "Invalid character in $_: $!";
}
my $epoch = 0;
my $name = basename( $_, '.torrent' );
if ( my ( $base, $year, $mon, $mday, $hour, $min )
= /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
{
$mon--;
$epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
$name = $base;
}
#print "Adding $_\n";
$files{$ext}{$name}{$epoch} = {
file => $_,
dir => $DIR,
path => "$DIR/$_",
ext => $ext,
#year => $year,
#mon => $mon,
#mday => $mday,
#hour => $hour,
#min => $min,
name => $name,
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;
}
#print Dump \%files;
foreach my $name ( sort keys %{ $files{torrent} } ) {
next unless $name =~ /^$Name_Filter/;
#print "Checking $name\n";
foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } )
{
#print "\t$epoch\n";
my $torrent = $files{torrent}{$name}{$epoch}{path};
if ( keys %{ $files{torrent}{$name} } == 1
&& $files{torrent}{$name}{$epoch}{dir} eq $OBT->{DIR_TORRENT} )
{
#print "Skipping torrent for $name there is only one.\n";
next;
}
my $t;
eval {
$t = BT::MetaInfo::Cached->new(
$torrent,
{ cache_root => '/tmp/OBTFileCache'
#$OBT->{DIR_HOME} . '/FileCache'
}
);
};
if ($@) {
warn "Error reading torrent $torrent\n";
push @delete, $files{torrent}{$name}{$epoch};
delete $files{torrent}{$name}{$epoch};
next;
}
$files{torrent}{$name}{$epoch}{comment} = $t->{comment};
my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
unless ( -e $OBT->{DIR_FTP} . "/$path" ) {
print
"Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n";
push @delete, $files{torrent}{$name}{$epoch};
delete $files{torrent}{$name}{$epoch};
next;
}
my $hash = $t->info_hash;
$hash = unpack( "H*", $hash );
undef $t;
$files{torrent}{$name}{$epoch}{info_hash} = $hash;
if ( exists $keep{$name} ) {
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};
delete $files{torrent}{ $keep{$name}{$hash}{name} }
{ $keep{$name}{$hash}{epoch} };
$keep{$name}{$hash} = $files{torrent}{$name}{$epoch};
print "Keeping additional instance of [$name] [$hash]\n\t",
$keep{$name}{$hash}{path},
"\n";
}
else {
print "Removing old [$name] [$hash]\n";
if ( $keep{$name}{$hash}{path} ) {
print "\t", $keep{$name}{$hash}{path}, "\n";
}
push @delete, $files{torrent}{$name}{$epoch};
delete $files{torrent}{$name}{$epoch};
}
}
else {
print "Keeping first instance of $name [$hash]\n\t",
$files{torrent}{$name}{$epoch}{path},
"\n";
$keep{$name}{$hash} = $files{torrent}{$name}{$epoch};
}
}
}
#print Dump \%files, \%keep, \@delete;
#exit;
foreach (@delete) {
print "Deleting '$_->{path}'\n";
unlink $_->{path} or die "Couldn't unlink $_->{path}";
}
foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
unless ( exists $files{torrent}{$name}{$epoch} ) {
my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};
print "Unlinking '$path'\n";
unlink $path or die "couldn't unlink '$path': $!";
}
}
}
#print Dump \%keep;
foreach my $name ( keys %keep ) {
foreach my $hash ( keys %{ $keep{$name} } ) {
my $file = $keep{$name}{$hash}{file} || q{};
my $dir = $keep{$name}{$hash}{dir} || q{};
if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
print "Moving $file to current torrents\n";
rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
or die "Couldn't rename '$file': $!";
my $name = $keep{$name}{$hash}{name};
my $epoch = $keep{$name}{$hash}{epoch};
if ( exists $files{txt}{$name}{$epoch} ) {
my $m_file = $files{txt}{$name}{$epoch}{file};
my $m_dir = $files{txt}{$name}{$epoch}{dir};
rename( "$m_dir/$m_file",
$OBT->{DIR_TORRENT} . "/" . $m_file )
or die "Couldn't rename '$m_file': $!";
}
}
}
}
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 $file (@$files) {
if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
$torrent = Name_Torrent("$dir/$file");
$torrent =~ s/-.*$//;
$Possible_Torrents{$torrent} = 1;
}
}
}
foreach my $subdir (@$dirs) {
next if $subdir eq '.';
next if $subdir eq '..';
Process_Dir("$basedir/$subdir");
}
}