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