#!/usr/bin/perl -T #$RedRiver: CurrentTorrents.pl,v 1.25 2008/11/14 18:18:31 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") } }