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