Annotation of openbsd/OpenBSDTorrents/CurrentTorrents.pl, Revision 1.13
1.1 andrew 1: #!/usr/bin/perl -T
1.13 ! andrew 2: #$Id: CurrentTorrents.pl,v 1.12 2005/05/02 20:27:00 andrew Exp andrew $
1.1 andrew 3: use strict;
4: use warnings;
5: use diagnostics;
6:
1.2 andrew 7: use Time::Local;
1.1 andrew 8:
1.9 andrew 9: use lib 'lib';
1.1 andrew 10: use OpenBSDTorrents;
1.13 ! andrew 11: use BT::OBTMetaInfo;
1.1 andrew 12:
13: %ENV = ();
14:
1.13 ! andrew 15: use YAML;
1.6 andrew 16:
17: justme();
1.1 andrew 18:
1.12 andrew 19: my $Name_Filter = shift || '';
20: if ($Name_Filter =~ /^(\w*)$/) {
21: $Name_Filter = $1;
22: } else {
23: die "Invalid filter: $Name_Filter";
24: }
25:
1.2 andrew 26: my %files;
1.13 ! andrew 27: foreach my $DIR ($OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT}) {
! 28: opendir DIR, $DIR
! 29: or die "Couldn't opendir $DIR: $!";
! 30: foreach (readdir DIR) {
! 31: next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
1.2 andrew 32:
1.13 ! andrew 33: if (/^([^\/]+)$/) {
! 34: $_ = $1;
! 35: } else {
! 36: die "Invalid character in $_: $!";
! 37: }
! 38: my ($name, $year, $mon, $mday, $hour, $min) =
! 39: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
1.2 andrew 40:
1.13 ! andrew 41: $mon--;
! 42: my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
1.2 andrew 43:
1.13 ! andrew 44: #print "Adding $_\n";
1.2 andrew 45:
1.13 ! andrew 46: $files{$ext}{$name}{$epoch} = {
! 47: file => $_,
! 48: dir => $DIR,
! 49: path => "$DIR/$_",
! 50: ext => $ext,
! 51: year => $year,
! 52: mon => $mon,
! 53: mday => $mday,
! 54: hour => $hour,
! 55: min => $min,
! 56: name => $name,
! 57: epoch => $epoch,
! 58: };
! 59:
! 60: }
! 61: closedir DIR;
1.2 andrew 62: }
63:
64: my %keep;
65: my @delete;
1.13 ! andrew 66: foreach my $name (keys %{ $files{torrent} }) {
1.12 andrew 67: next unless $name =~ /^$Name_Filter/;
68: print "Checking $name\n";
1.4 andrew 69:
1.13 ! andrew 70: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {
1.4 andrew 71: #print "\t$epoch\n";
1.13 ! andrew 72: my $torrent = $files{torrent}{$name}{$epoch}{path};
1.4 andrew 73:
74: my $t;
1.13 ! andrew 75: eval { $t = BT::OBTMetaInfo->new( $torrent ); };
! 76:
1.4 andrew 77: if ($@) {
78: warn "Error reading torrent $torrent\n";
79: next;
80: }
81:
1.13 ! andrew 82: $files{torrent}{$name}{$epoch}{comment} = $t->{comment};
1.4 andrew 83: my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
84:
1.10 andrew 85: unless (-d $OBT->{DIR_FTP} . "/$path") {
1.13 ! andrew 86: #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n";
! 87: push @delete, $files{torrent}{$name}{$epoch};
! 88: delete $files{torrent}{$name}{$epoch};
! 89: next;
1.4 andrew 90: }
91:
1.13 ! andrew 92: if (
! 93: keys %{ $files{torrent}{$name} } == 1 &&
! 94: $files{torrent}{$name}{$epoch}{dir}
! 95: eq $OBT->{DIR_TORRENT}
! 96: ) {
1.7 andrew 97: #print "Skipping torrent for $name there is only one.\n";
1.4 andrew 98: next;
99: }
100:
1.13 ! andrew 101: my $hash = $t->info_hash_cached($torrent);
1.4 andrew 102: $hash = unpack("H*", $hash);
103:
1.13 ! andrew 104: $files{torrent}{$name}{$epoch}{info_hash} = $hash;
1.4 andrew 105:
106: undef $t;
107:
1.2 andrew 108: if (exists $keep{$name}) {
109: if (exists $keep{$name}{$hash}) {
110: push @delete, $keep{$name}{$hash};
1.13 ! andrew 111: delete $files{torrent}{
! 112: $keep{$name}{$hash}{name}
! 113: }{
! 114: $keep{$name}{$hash}{epoch}
! 115: };
1.2 andrew 116: $keep{$name}{$hash} =
1.13 ! andrew 117: $files{torrent}{$name}{$epoch};
1.2 andrew 118: } else {
1.13 ! andrew 119: push @delete, $files{torrent}{$name}{$epoch};
! 120: delete $files{torrent}{$name}{$epoch};
1.2 andrew 121: }
122: } else {
123: $keep{$name}{$hash} =
1.13 ! andrew 124: $files{torrent}{$name}{$epoch};
1.2 andrew 125:
126: }
127: }
128: }
129:
130: #print Dump \%files, \%keep, \@delete;
131:
132: foreach (@delete) {
1.13 ! andrew 133: print "Deleting '$_->{path}'\n";
! 134: unlink $_->{path} or die "Couldn't unlink $_->{path}";
! 135: }
! 136:
! 137: foreach my $name (keys %{ $files{$OBT->{META_EXT} } }) {
! 138: foreach my $epoch (keys %{ $files{ $OBT->{META_EXT} }{$name} }) {
! 139: unless ( exists $files{torrent}{$name}{$epoch} ) {
! 140: my $path = $files{$OBT->{META_EXT}}{$name}{$epoch}{path};
! 141: print "Unlinking '$path'\n";
! 142: unlink $path or die "couldn't unlink '$path': $!";
! 143: }
! 144: }
! 145: }
! 146:
! 147:
! 148: #print Dump \%keep;
! 149: foreach my $name (keys %keep) {
! 150: foreach my $hash (keys %{ $keep{$name} }) {
! 151: my $file = $keep{$name}{$hash}{file};
! 152: my $dir = $keep{$name}{$hash}{dir };
! 153: if ($dir eq $OBT->{DIR_NEW_TORRENT}) {
! 154: print "Moving $file to current torrents\n";
! 155: rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file)
! 156: or die "Couldn't rename '$file': $!";
! 157:
! 158: my $name = $keep{$name}{$hash}{name};
! 159: my $epoch = $keep{$name}{$hash}{epoch};
! 160:
! 161: if (exists $files{txt}{$name}{$epoch}) {
! 162: my $m_file = $files{txt}{$name}{$epoch}{file};
! 163: my $m_dir = $files{txt}{$name}{$epoch}{dir };
! 164: rename(
! 165: "$m_dir/$m_file",
! 166: $OBT->{DIR_TORRENT} . "/" . $m_file
! 167: ) or die "Couldn't rename '$m_file': $!";
! 168: }
! 169: }
! 170: }
1.2 andrew 171: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>