Annotation of openbsd/OpenBSDTorrents/CurrentTorrents.pl, Revision 1.30
1.1 andrew 1: #!/usr/bin/perl -T
1.30 ! andrew 2: #$RedRiver: CurrentTorrents.pl,v 1.29 2010/01/08 17:18:35 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.29 andrew 11: use Transmission::Client;
12: use Transmission::Utils;
13:
1.23 andrew 14: #use YAML;
1.1 andrew 15:
1.9 andrew 16: use lib 'lib';
1.1 andrew 17: use OpenBSDTorrents;
1.17 andrew 18: use BT::MetaInfo::Cached;
1.1 andrew 19:
20: %ENV = ();
21:
1.15 andrew 22: #justme();
1.1 andrew 23:
1.12 andrew 24: my $Name_Filter = shift || '';
1.27 andrew 25: if ( $Name_Filter =~ /^(\w*)$/ ) {
26: $Name_Filter = $1;
27: }
28: else {
29: die "Invalid filter: $Name_Filter";
1.12 andrew 30: }
31:
1.15 andrew 32: my %Possible_Torrents;
1.27 andrew 33: Process_Dir( $OBT->{DIR_FTP} );
1.15 andrew 34:
1.2 andrew 35: my %files;
1.15 andrew 36: my @delete;
1.27 andrew 37: foreach my $DIR ( $OBT->{DIR_NEW_TORRENT}, $OBT->{DIR_TORRENT} ) {
38: opendir DIR, $DIR
39: or die "Couldn't opendir $DIR: $!";
40: foreach ( readdir DIR ) {
41: next unless my ($ext) = /\.(torrent|$OBT->{META_EXT})$/;
42:
43: if (/^([^\/]+)$/) {
44: $_ = $1;
45: }
46: else {
47: die "Invalid character in $_: $!";
48: }
49: my $epoch = 0;
50: my $name = basename( $_, '.torrent' );
51:
52: if ( my ( $base, $year, $mon, $mday, $hour, $min )
53: = /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/ )
54: {
55:
56: $mon--;
57: $epoch = timegm( 0, $min, $hour, $mday, $mon, $year );
58: $name = $base;
59: }
60:
61: #print "Adding $_\n";
62:
63: $files{$ext}{$name}{$epoch} = {
64: file => $_,
65: dir => $DIR,
66: path => "$DIR/$_",
67: ext => $ext,
68:
69: #year => $year,
70: #mon => $mon,
71: #mday => $mday,
72: #hour => $hour,
73: #min => $min,
74: name => $name,
75: epoch => $epoch,
76: };
77:
78: if ( $name =~ m/\A $OBT->{BASENAME} /xms
79: && !exists $Possible_Torrents{$name} )
80: {
81: print "Would remove $_\n";
82: push @delete, $files{$ext}{$name}{$epoch};
83: }
84: }
85: closedir DIR;
1.2 andrew 86: }
87:
1.25 andrew 88: #print Dump \%files;
1.28 andrew 89:
90: my %keep;
1.29 andrew 91: my %seen;
1.27 andrew 92: foreach my $name ( sort keys %{ $files{torrent} } ) {
93: next unless $name =~ /^$Name_Filter/;
94:
1.29 andrew 95: #next if $name =~ /_packages_/xms;
1.27 andrew 96: #print "Checking $name\n";
97:
1.29 andrew 98: my $cn = $files{torrent}{$name};
1.27 andrew 99:
1.30 ! andrew 100: EPOCH: foreach my $epoch ( sort { $a <=> $b } keys %{$cn} ) {
1.29 andrew 101: my $ct = $cn->{$epoch};
102: my $cf = $ct->{path};
1.27 andrew 103:
1.29 andrew 104: #print "\t$epoch - $cf\n";
1.27 andrew 105:
106: my $t;
107: eval {
1.29 andrew 108: $t
109: = BT::MetaInfo::Cached->new( $cf,
110: { cache_root => '/tmp/OBTFileCache' } );
1.27 andrew 111: };
112:
113: if ($@) {
1.29 andrew 114: warn "Error reading torrent $cf\n";
115: push @delete, $ct;
116: delete $cn->{$epoch};
117: next EPOCH;
1.27 andrew 118: }
119:
1.29 andrew 120: $ct->{comment} = $t->{comment};
1.27 andrew 121: my ($path) = $t->{comment} =~ /($OBT->{BASENAME}\/[^\n]+)\n/s;
122:
1.29 andrew 123: if ( !-e $OBT->{DIR_FTP} . "/$path" ) {
1.27 andrew 124: print
1.29 andrew 125: 'Deleting ',
126: $cn->{$epoch}{file}, ' the path (', $path,
127: ") doesn't exist.\n";
128: push @delete, $ct;
129: delete $cn->{$epoch};
130: next EPOCH;
1.27 andrew 131: }
132:
1.29 andrew 133: my $hash = unpack( "H*", $t->info_hash );
134: $ct->{info_hash} = $hash;
1.27 andrew 135:
136: undef $t;
137:
1.29 andrew 138: if ( $seen{$name} && $seen{$name} ne $hash ) {
139: print "Removing older [$name] [$hash]\n";
140: if ( $keep{$hash}{path} ) {
141: print "\t", $keep{$hash}{path}, "\n";
142: }
143: push @delete, $ct;
144: delete $cn->{$epoch};
145: next EPOCH;
146: }
147: $seen{$name} = $hash;
148:
149: if ( keys %{$cn} == 1 && $ct->{dir} eq $OBT->{DIR_TORRENT} ) {
150: $keep{$hash} = $ct;
1.27 andrew 151:
1.29 andrew 152: #print "Keeping only instance of [$name] [$hash]\n\t",
153: # $ct->{path},
154: # "\n";
155: next EPOCH;
156: }
157: elsif ( $keep{$hash} ) {
1.28 andrew 158: if ( $keep{$hash}{epoch} == $epoch ) {
1.29 andrew 159: next EPOCH;
1.27 andrew 160: }
1.29 andrew 161:
162: print "Removing duplicate [$name] [$hash]\n\t",
163: $keep{$hash}{path}, "\n";
1.28 andrew 164: push @delete, $keep{$hash};
165: delete $files{torrent}{ $keep{$hash}{name} }
166: { $keep{$hash}{epoch} };
1.29 andrew 167:
168: $keep{$hash} = $ct;
169: print "Keeping additional instance of [$name] [$hash]\n\t",
170: $ct->{path},
1.28 andrew 171: "\n";
172: }
173: else {
1.29 andrew 174: $keep{$hash} = $ct;
175: print "Keeping first instance of [$name] [$hash]\n\t",
176: $ct->{path},
1.27 andrew 177: "\n";
1.2 andrew 178:
1.27 andrew 179: }
180: }
1.2 andrew 181: }
182:
183: #print Dump \%files, \%keep, \@delete;
1.23 andrew 184: #exit;
1.2 andrew 185:
1.29 andrew 186: my $client = Transmission::Client->new;
187: my %seeding;
188: foreach my $torrent ( @{ $client->torrents } ) {
189:
190: #my $status = Transmission::Utils::from_numeric_status($torrent->status);
191: my $hash = $torrent->hash_string;
192: if ( exists $keep{$hash} ) {
193: $seeding{$hash} = $torrent;
194: }
195: else {
196: print "No longer seeding [$hash]\n";
197: $torrent->stop or warn $torrent->error_string;
198: $client->remove( $torrent->id ) or warn $client->error;
1.27 andrew 199: }
1.13 andrew 200: }
201:
1.27 andrew 202: #print Dump \%keep;
1.28 andrew 203: foreach my $hash ( keys %keep ) {
204: my $file = $keep{$hash}{file} || q{};
205: my $dir = $keep{$hash}{dir} || q{};
206: if ( $dir eq $OBT->{DIR_NEW_TORRENT} ) {
207: print "Moving $file to current torrents\n";
208: rename( "$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file )
209: or die "Couldn't rename '$file': $!";
210:
211: my $name = $keep{$hash}{name};
212: my $epoch = $keep{$hash}{epoch};
1.29 andrew 213: $dir = $OBT->{DIR_TORRENT};
1.28 andrew 214:
215: if ( exists $files{txt}{$name}{$epoch} ) {
216: my $m_file = $files{txt}{$name}{$epoch}{file};
217: my $m_dir = $files{txt}{$name}{$epoch}{dir};
218: rename( "$m_dir/$m_file", $OBT->{DIR_TORRENT} . "/" . $m_file )
219: or die "Couldn't rename '$m_file': $!";
1.27 andrew 220: }
221: }
1.29 andrew 222:
223: if ( !$seeding{$hash} ) {
224: print "Starting seed of [$file] [$hash]\n";
225: if (!$client->add(
226: filename => "$dir/$file",
227: download_dir => $OBT->{DIR_FTP},
228: )
229: )
230: {
231:
232: #warn $client->error, ": $dir/$file\n";
233: print "Removing invalid torrent\n\t", $keep{$hash}{path}, "\n";
234: push @delete, $keep{$hash};
235: delete $files{torrent}{ $keep{$hash}{name} }
236: { $keep{$hash}{epoch} };
237: }
238: }
239: }
240:
241: foreach (@delete) {
242: if ( $_->{path} ) {
243: print "Deleting '$_->{path}'\n";
244: unlink $_->{path} or die "Couldn't unlink $_->{path}";
245: }
246: else {
247: use Data::Dumper;
248: print Dumper $_;
249: }
250: }
251:
252: foreach my $name ( keys %{ $files{ $OBT->{META_EXT} } } ) {
253: foreach my $epoch ( keys %{ $files{ $OBT->{META_EXT} }{$name} } ) {
254: unless ( exists $files{torrent}{$name}{$epoch} ) {
255: my $path = $files{ $OBT->{META_EXT} }{$name}{$epoch}{path};
256: print "Unlinking '$path'\n";
257: unlink $path or die "couldn't unlink '$path': $!";
258: }
259: }
1.13 andrew 260: }
1.29 andrew 261:
262: $client->start;
1.13 andrew 263:
1.27 andrew 264: sub Process_Dir {
265: my $basedir = shift;
1.13 andrew 266:
1.27 andrew 267: my ( $dirs, $files ) = Get_Files_and_Dirs($basedir);
268: if (@$files) {
269: my $dir = $basedir;
270: $dir =~ s/^$OBT->{DIR_FTP}\///;
271: my $torrent = Name_Torrent($dir);
272: $torrent =~ s/-.*$//;
273: $Possible_Torrents{$torrent} = 1;
274: foreach my $file (@$files) {
275: if ( $file =~ /$INSTALL_ISO_REGEX/ ) {
276: $torrent = Name_Torrent("$dir/$file");
277: $torrent =~ s/-.*$//;
278: $Possible_Torrents{$torrent} = 1;
279: }
1.15 andrew 280: }
1.27 andrew 281: }
282:
283: foreach my $subdir (@$dirs) {
284: next if $subdir eq '.';
285: next if $subdir eq '..';
286: Process_Dir("$basedir/$subdir");
287: }
1.15 andrew 288: }
289:
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