Annotation of openbsd/OpenBSDTorrents/CurrentTorrents.pl, Revision 1.27
1.1 andrew 1: #!/usr/bin/perl -T
1.27 ! andrew 2: #$RedRiver: CurrentTorrents.pl,v 1.26 2009/10/20 19:04:28 andrew Exp $
1.1 andrew 3: use strict;
4: use warnings;
5: use diagnostics;
6:
1.2 andrew 7: use Time::Local;
1.16 andrew 8: use Fcntl ':flock';
1.23 andrew 9: use File::Basename;
1.27 ! andrew 10:
1.23 andrew 11: #use YAML;
1.1 andrew 12:
1.9 andrew 13: use lib 'lib';
1.1 andrew 14: use OpenBSDTorrents;
1.17 andrew 15: use BT::MetaInfo::Cached;
1.1 andrew 16:
17: %ENV = ();
18:
1.15 andrew 19: #justme();
1.1 andrew 20:
1.12 andrew 21: my $Name_Filter = shift || '';
1.27 ! andrew 22: if ( $Name_Filter =~ /^(\w*)$/ ) {
! 23: $Name_Filter = $1;
! 24: }
! 25: else {
! 26: die "Invalid filter: $Name_Filter";
1.12 andrew 27: }
28:
1.15 andrew 29: my %Possible_Torrents;
1.27 ! andrew 30: Process_Dir( $OBT->{DIR_FTP} );
1.15 andrew 31:
1.2 andrew 32: my %files;
1.15 andrew 33: my %keep;
34: my @delete;
1.27 ! andrew 35: foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
! 36: opendir DIR, $DIR
! 37: or die "Couldn't opendir $DIR: $!";
! 38: foreach ( readdir DIR ) {
! 39: next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
! 40:
! 41: if (/^([^\/]+)$/) {
! 42: $_ = $1;
! 43: }
! 44: else {
! 45: die "Invalid character in $_: $!";
! 46: }
! 47: my $epoch = 0;
! 48: my $name = basename( $_, '.torrent' );
! 49:
! 50: if ( my ( $base, $year, $mon, $mday, $hour, $min )
! 51: = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
! 52: {
! 53:
! 54: $mon--;
! 55: $epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
! 56: $name = $base;
! 57: }
! 58:
! 59: #print "Adding $_\n";
! 60:
! 61: $files{$ext}{$name}{$epoch} = {
! 62: file => $_,
! 63: dir => $DIR,
! 64: path => "$DIR/$_",
! 65: ext => $ext,
! 66:
! 67: #year => $year,
! 68: #mon => $mon,
! 69: #mday => $mday,
! 70: #hour => $hour,
! 71: #min => $min,
! 72: name => $name,
! 73: epoch => $epoch,
! 74: };
! 75:
! 76: if ( $name =~ m/\A $OBT->{BASENAME} /xms
! 77: && !exists $Possible_Torrents{$name} )
! 78: {
! 79: print "Would remove $_\n";
! 80: push @delete, $files{$ext}{$name}{$epoch};
! 81: }
! 82: }
! 83: closedir DIR;
1.2 andrew 84: }
85:
1.25 andrew 86: #print Dump \%files;
1.27 ! andrew 87: foreach my $name ( sort keys %{ $files{torrent} } ) {
! 88: next unless $name =~ /^$Name_Filter/;
! 89:
! 90: #print "Checking $name\n";
! 91:
! 92: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } )
! 93: {
! 94:
! 95: #print "\t$epoch\n";
! 96: my $torrent = $files{torrent}{$name}{$epoch}{path};
! 97:
! 98: if ( keys %{ $files{torrent}{$name} } == 1
! 99: && $files{torrent}{$name}{$epoch}{dir} eq $OBT->{DIR_TORRENT} )
! 100: {
! 101:
! 102: #print "Skipping torrent for $name there is only one.\n";
! 103: next;
! 104: }
! 105:
! 106: my $t;
! 107: eval {
! 108: $t = BT::MetaInfo::Cached->new(
! 109: $torrent,
! 110: { cache_root => '/tmp/OBTFileCache'
! 111:
! 112: #$OBT->{DIR_HOME} . '/FileCache'
! 113: }
! 114: );
! 115: };
! 116:
! 117: if ($@) {
! 118: warn "Error reading torrent $torrent\n";
! 119: push @delete, $files{torrent}{$name}{$epoch};
! 120: delete $files{torrent}{$name}{$epoch};
! 121: next;
! 122: }
! 123:
! 124: $files{torrent}{$name}{$epoch}{comment} = $t->{comment};
! 125: my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
! 126:
! 127: unless ( -e $OBT->{DIR_FTP} . "/$path" ) {
! 128: print
! 129: "Deleting $files{torrent}{$name}{$epoch}{file} the path ($path) doesn't exist.\n";
! 130: push @delete, $files{torrent}{$name}{$epoch};
! 131: delete $files{torrent}{$name}{$epoch};
! 132: next;
! 133: }
! 134:
! 135: my $hash = $t->info_hash;
! 136: $hash = unpack( "H*", $hash );
! 137:
! 138: undef $t;
! 139:
! 140: $files{torrent}{$name}{$epoch}{info_hash} = $hash;
! 141:
! 142: if ( exists $keep{$name} ) {
! 143: if ( exists $keep{$name}{$hash} ) {
! 144: if ( $keep{$name}{$hash}{epoch} == $epoch ) {
! 145: next;
! 146: }
! 147: print "Removing [$name] [$hash]\n\t",
! 148: $keep{$name}{$hash}{path},
! 149: "\n";
! 150: push @delete, $keep{$name}{$hash};
! 151: delete $files{torrent}{ $keep{$name}{$hash}{name} }
! 152: { $keep{$name}{$hash}{epoch} };
! 153: $keep{$name}{$hash} = $files{torrent}{$name}{$epoch};
! 154: print "Keeping additional instance of [$name] [$hash]\n\t",
! 155: $keep{$name}{$hash}{path},
! 156: "\n";
! 157: }
! 158: else {
! 159: print "Removing old [$name] [$hash]\n";
! 160: if ( $keep{$name}{$hash}{path} ) {
! 161: print "\t", $keep{$name}{$hash}{path}, "\n";
! 162: }
! 163: push @delete, $files{torrent}{$name}{$epoch};
! 164: delete $files{torrent}{$name}{$epoch};
! 165: }
! 166: }
! 167: else {
! 168: print "Keeping first instance of $name [$hash]\n\t",
! 169: $files{torrent}{$name}{$epoch}{path},
! 170: "\n";
! 171: $keep{$name}{$hash} = $files{torrent}{$name}{$epoch};
1.2 andrew 172:
1.27 ! andrew 173: }
! 174: }
1.2 andrew 175: }
176:
177: #print Dump \%files, \%keep, \@delete;
1.23 andrew 178: #exit;
1.2 andrew 179:
180: foreach (@delete) {
1.27 ! andrew 181: print "Deleting '$_->{path}'\n";
! 182: unlink $_->{path} or die "Couldn't unlink $_->{path}";
! 183: }
! 184:
! 185: foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
! 186: foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
! 187: unless ( exists $files{torrent}{$name}{$epoch} ) {
! 188: my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};
! 189: print "Unlinking '$path'\n";
! 190: unlink $path or die "couldn't unlink '$path': $!";
! 191: }
! 192: }
1.13 andrew 193: }
194:
1.27 ! andrew 195: #print Dump \%keep;
! 196: foreach my $name ( keys %keep ) {
! 197: foreach my $hash ( keys %{ $keep{$name} } ) {
! 198: my $file = $keep{$name}{$hash}{file} || q{};
! 199: my $dir = $keep{$name}{$hash}{dir} || q{};
! 200: if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
! 201: print "Moving $file to current torrents\n";
! 202: rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
! 203: or die "Couldn't rename '$file': $!";
! 204:
! 205: my $name = $keep{$name}{$hash}{name};
! 206: my $epoch = $keep{$name}{$hash}{epoch};
! 207:
! 208: if ( exists $files{txt}{$name}{$epoch} ) {
! 209: my $m_file = $files{txt}{$name}{$epoch}{file};
! 210: my $m_dir = $files{txt}{$name}{$epoch}{dir};
! 211: rename( "$m_dir/$m_file",
! 212: $OBT->{DIR_TORRENT} . "/" . $m_file )
! 213: or die "Couldn't rename '$m_file': $!";
! 214: }
! 215: }
! 216: }
1.13 andrew 217: }
218:
1.27 ! andrew 219: sub Process_Dir {
! 220: my $basedir = shift;
1.13 andrew 221:
1.27 ! andrew 222: my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
! 223: if (@$files) {
! 224: my $dir = $basedir;
! 225: $dir =~ s/^$OBT->{DIR_FTP}\///;
! 226: my $torrent = Name_Torrent($dir);
! 227: $torrent =~ s/-.*$//;
! 228: $Possible_Torrents{$torrent} = 1;
! 229: foreach my $file (@$files) {
! 230: if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
! 231: $torrent = Name_Torrent("$dir/$file");
! 232: $torrent =~ s/-.*$//;
! 233: $Possible_Torrents{$torrent} = 1;
! 234: }
1.15 andrew 235: }
1.27 ! andrew 236: }
! 237:
! 238: foreach my $subdir (@$dirs) {
! 239: next if $subdir eq '.';
! 240: next if $subdir eq '..';
! 241: Process_Dir("$basedir/$subdir");
! 242: }
1.15 andrew 243: }
244:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to CurrentTorrents.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / openbsd / OpenBSDTorrents