![[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.20 ! andrew 2: #$Id: CurrentTorrents.pl,v 1.19 2005/06/01 17:52:14 andrew Exp andrew $
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.1 andrew 9:
1.9 andrew 10: use lib 'lib';
1.1 andrew 11: use OpenBSDTorrents;
1.17 andrew 12: use BT::MetaInfo::Cached;
1.1 andrew 13:
14: %ENV = ();
15:
1.13 andrew 16: use YAML;
1.6 andrew 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: }
44: my ($name, $year, $mon, $mday, $hour, $min) =
45: /^(.*)-(\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})/;
1.2 andrew 46:
1.13 andrew 47: $mon--;
48: my $epoch = timegm(0,$min,$hour,$mday,$mon,$year);
1.2 andrew 49:
1.13 andrew 50: #print "Adding $_\n";
1.2 andrew 51:
1.13 andrew 52: $files{$ext}{$name}{$epoch} = {
53: file => $_,
54: dir => $DIR,
55: path => "$DIR/$_",
56: ext => $ext,
57: year => $year,
58: mon => $mon,
59: mday => $mday,
60: hour => $hour,
61: min => $min,
62: name => $name,
63: epoch => $epoch,
64: };
65:
1.15 andrew 66: unless (exists $Possible_Torrents{$name}) {
67: print "Would remove $_\n";
68: push @delete, $files{$ext}{$name}{$epoch};
69: }
1.13 andrew 70: }
71: closedir DIR;
1.2 andrew 72: }
73:
1.13 andrew 74: foreach my $name (keys %{ $files{torrent} }) {
1.12 andrew 75: next unless $name =~ /^$Name_Filter/;
76: print "Checking $name\n";
1.4 andrew 77:
1.13 andrew 78: foreach my $epoch ( sort { $b <=> $a } keys %{ $files{torrent}{$name} } ) {
1.4 andrew 79: #print "\t$epoch\n";
1.13 andrew 80: my $torrent = $files{torrent}{$name}{$epoch}{path};
1.4 andrew 81:
1.14 andrew 82: if (
83: keys %{ $files{torrent}{$name} } == 1 &&
84: $files{torrent}{$name}{$epoch}{dir}
85: eq $OBT->{DIR_TORRENT}
86: ) {
87: #print "Skipping torrent for $name there is only one.\n";
88: next;
89: }
90:
1.4 andrew 91: my $t;
1.18 andrew 92: eval {
93: $t = BT::MetaInfo::Cached->new(
94: $torrent,
95: {
96: cache_root =>
97: $OBT->{DIR_HOME} . '/FileCache'
98: }
99: );
100: };
1.13 andrew 101:
1.4 andrew 102: if ($@) {
103: warn "Error reading torrent $torrent\n";
104: next;
105: }
106:
1.13 andrew 107: $files{torrent}{$name}{$epoch}{comment} = $t->{comment};
1.4 andrew 108: my ($path) = $t->{comment} =~ /Files from ([^\n]+)\n/s;
109:
1.10 andrew 110: unless (-d $OBT->{DIR_FTP} . "/$path") {
1.13 andrew 111: #print "Deleting $files{torrent}{$name}{$epoch}{file} the path doesn't exist.\n";
112: push @delete, $files{torrent}{$name}{$epoch};
113: delete $files{torrent}{$name}{$epoch};
1.4 andrew 114: next;
115: }
116:
1.17 andrew 117: my $hash = $t->info_hash;
1.4 andrew 118: $hash = unpack("H*", $hash);
119:
1.16 andrew 120: undef $t;
121:
1.13 andrew 122: $files{torrent}{$name}{$epoch}{info_hash} = $hash;
1.4 andrew 123:
124:
1.2 andrew 125: if (exists $keep{$name}) {
126: if (exists $keep{$name}{$hash}) {
127: push @delete, $keep{$name}{$hash};
1.13 andrew 128: delete $files{torrent}{
129: $keep{$name}{$hash}{name}
130: }{
131: $keep{$name}{$hash}{epoch}
132: };
1.2 andrew 133: $keep{$name}{$hash} =
1.13 andrew 134: $files{torrent}{$name}{$epoch};
1.2 andrew 135: } else {
1.13 andrew 136: push @delete, $files{torrent}{$name}{$epoch};
137: delete $files{torrent}{$name}{$epoch};
1.2 andrew 138: }
139: } else {
140: $keep{$name}{$hash} =
1.13 andrew 141: $files{torrent}{$name}{$epoch};
1.2 andrew 142:
143: }
144: }
145: }
146:
147: #print Dump \%files, \%keep, \@delete;
148:
149: foreach (@delete) {
1.13 andrew 150: print "Deleting '$_->{path}'\n";
151: unlink $_->{path} or die "Couldn't unlink $_->{path}";
152: }
153:
154: foreach my $name (keys %{ $files{$OBT->{META_EXT} } }) {
155: foreach my $epoch (keys %{ $files{ $OBT->{META_EXT} }{$name} }) {
156: unless ( exists $files{torrent}{$name}{$epoch} ) {
157: my $path = $files{$OBT->{META_EXT}}{$name}{$epoch}{path};
158: print "Unlinking '$path'\n";
159: unlink $path or die "couldn't unlink '$path': $!";
160: }
161: }
162: }
163:
164:
1.20 ! andrew 165: #print Dump \%keep;
! 166: foreach my $name (keys %keep) {
! 167: foreach my $hash (keys %{ $keep{$name} }) {
! 168: my $file = $keep{$name}{$hash}{file};
! 169: my $dir = $keep{$name}{$hash}{dir };
! 170: if ($dir eq $OBT->{DIR_NEW_TORRENT}) {
! 171: print "Moving $file to current torrents\n";
! 172: rename("$dir/$file", $OBT->{DIR_TORRENT} . "/" . $file)
! 173: or die "Couldn't rename '$file': $!";
! 174:
! 175: my $name = $keep{$name}{$hash}{name};
! 176: my $epoch = $keep{$name}{$hash}{epoch};
! 177:
! 178: if (exists $files{txt}{$name}{$epoch}) {
! 179: my $m_file = $files{txt}{$name}{$epoch}{file};
! 180: my $m_dir = $files{txt}{$name}{$epoch}{dir };
! 181: rename(
! 182: "$m_dir/$m_file",
! 183: $OBT->{DIR_TORRENT} . "/" . $m_file
! 184: ) or die "Couldn't rename '$m_file': $!";
! 185: }
! 186: }
! 187: }
! 188: }
1.15 andrew 189:
190: sub Process_Dir
191: {
192: my $basedir = shift;
193:
194: my ($dirs, $files) = Get_Files_and_Dirs($basedir);
195: if (@$files) {
196: my $dir = $basedir;
197: $dir =~ s/^$OBT->{DIR_FTP}\///;
198: my $torrent = Name_Torrent($dir);
199: $torrent =~ s/-.*$//;
200: $Possible_Torrents{$torrent} = 1;
201: }
202:
203: foreach my $subdir (@$dirs) {
204: next if $subdir eq '.';
205: next if $subdir eq '..';
206: Process_Dir("$basedir/$subdir")
207: }
208: }
209: