| version 1.5, 2005/04/01 01:35:56 |
version 1.10, 2006/07/24 19:03:53 |
|
|
| #!/usr/bin/perl -T |
#!/usr/bin/perl -T |
| #$Id$ |
#$RedRiver: NewTorrents.pl,v 1.9 2006/05/15 18:47:04 andrew Exp $ |
| use strict; |
use strict; |
| use warnings; |
use warnings; |
| use diagnostics; |
use diagnostics; |
|
|
| use lib 'lib'; |
use lib 'lib'; |
| use OpenBSDTorrents; |
use OpenBSDTorrents; |
| |
|
| use POSIX 'setsid'; |
use POSIX qw / setsid :sys_wait_h /; |
| |
$SIG{CHLD} = \&REAPER; |
| |
my %Kids; |
| |
my %Kid_Status; |
| |
my %Need_Update; |
| |
|
| %ENV = (); |
%ENV = (); |
| |
|
| use YAML; |
use YAML; |
| |
|
| # *** This requires --log-format="%t [%p] %o %f %l" on the rsync command |
|
| |
|
| my $last_dir = ''; |
my $last_dir = ''; |
| while (<>) { |
while (<>) { |
| chomp; |
chomp; |
| if (my ($year, $mon, $mday, $time, $pid, $oper, $file, $size) = |
print $_, "\n"; |
| m#^(\d{4})/(\d{2})/(\d{2}) (\d{2}:\d{2}:\d{2}) \[(\d+)\] (\S+) (.+) (\d+)$# ) { |
if (my ($message, $file) = m#(.*)\s+\`([^']+)'#) { |
| #print "($year, $mon, $mday, $time, $pid, $oper, $file, $size)\n"; |
next if $message eq 'Making directory'; |
| my ($dir, $file) = $file =~ m#^(.*)/([^/]+)#; |
|
| #print "$dir - $file\n"; |
my $dir = ''; |
| |
if ($file =~ m#^(.*)/([^/]+)#) { |
| |
($dir, $file) = ($1, $2); |
| |
} |
| |
#print "$message - $dir - $file\n"; |
| if ($last_dir && $last_dir ne $dir) { |
if ($last_dir && $last_dir ne $dir) { |
| StartTorrent($last_dir); |
StartTorrent($last_dir); |
| } |
} |
| $last_dir = $dir; |
$last_dir = $dir; |
| } else { |
|
| #print $_; |
|
| } |
} |
| } |
} |
| |
|
| |
# Regen just the new ones now |
| |
sleep(1) while (keys %Kids > 0); |
| StartTorrent($last_dir); |
StartTorrent($last_dir); |
| |
|
| sleep(300); |
# after the new ones are done, regen all, just to make sure |
| |
sleep(1) while (keys %Kids > 0); |
| StartTorrent('skip'); |
StartTorrent('skip'); |
| |
|
| |
sub REAPER { |
| |
my $child; |
| |
while (($child = waitpid(-1,WNOHANG)) > 0) { |
| |
$Kid_Status{$child} = $?; |
| |
delete $Kids{$child}; |
| |
} |
| |
$SIG{CHLD} = \&REAPER; # still loathe sysV |
| |
} |
| |
|
| sub StartTorrent |
sub StartTorrent |
| { |
{ |
| my $dir = shift; |
my $dir = shift; |
| return undef unless $dir; |
return undef unless $dir; |
| |
|
| if ($dir ne 'skip') { |
my $should_fork = 1; |
| $dir = "$BaseName/$dir"; |
|
| |
if ($dir eq 'skip') { |
| |
#$dir = ''; |
| |
%Need_Update = (); |
| |
$should_fork = 0; |
| } else { |
} else { |
| $dir = ''; |
$dir = $OBT->{BASENAME} . "/$dir"; |
| |
$Need_Update{$dir} = 1; |
| } |
} |
| |
|
| # This actually needs to be a sub that forks off |
if (keys %Kids > 0) { |
| # the generation of this, and the running of the update script. |
print "Not making torrents for $dir now, already running\n"; |
| |
return undef; |
| |
} |
| |
|
| #defined(my $pid = fork) or die "Can't fork: $!"; |
my @now_update = keys %Need_Update; |
| |
%Need_Update = (); |
| |
|
| #return if $pid; |
if ($should_fork) { |
| |
defined(my $pid = fork) or die "Can't fork: $!"; |
| |
|
| #chdir $HomeDir or die "Can't chdir to $HomeDir: $!"; |
if ($pid) { |
| |
$Kids{$pid} = 1; |
| |
return undef; |
| |
} |
| |
|
| #setsid or die "Can't start a new session: $!"; |
} |
| ##open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; |
|
| ##open STDOUT, '>/dev/null' |
|
| ## or die "Can't write /dev/null: $!"; |
|
| ##open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; |
|
| |
|
| print "Making torrents for $dir\n"; |
if (@now_update) { |
| exec($HomeDir . '/regen.sh' . " $dir &"); |
print "Making torrents for ", join(" ", @now_update), "\n"; |
| #exec($HomeDir . '/regen.sh', "$dir"); |
} else { |
| |
print "Remaking all torrents\n"; |
| |
push @now_update, $dir; |
| |
} |
| |
exec($OBT->{DIR_HOME} . '/regen.sh', @now_update); |
| } |
} |