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