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