Return to NewTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

Annotation of openbsd/OpenBSDTorrents/NewTorrents.pl, Revision 1.16

1.1       andrew      1: #!/usr/bin/perl -T
1.16    ! andrew      2: #$RedRiver: NewTorrents.pl,v 1.15 2010/03/03 18:23:46 andrew Exp $
1.1       andrew      3: use strict;
                      4: use warnings;
                      5: use diagnostics;
                      6:
                      7: use lib 'lib';
                      8: use OpenBSDTorrents;
                      9:
1.7       andrew     10: use POSIX qw / setsid :sys_wait_h /;
                     11: $SIG{CHLD} = \&REAPER;
                     12: my %Kids;
                     13: my %Kid_Status;
                     14: my %Need_Update;
1.3       andrew     15:
1.1       andrew     16: %ENV = ();
                     17:
                     18: my $last_dir = '';
                     19: while (<>) {
1.13      andrew     20:        #print;
1.1       andrew     21:        chomp;
1.14      andrew     22:        # *** This requires --log-format="%t [%p] %o %f %l" on the rsync command
                     23:        if (my ($year,  $mon,   $mday,     $time,
                     24:                 $pid,        $oper,    $file,  $size) = m#^
                     25:                (\d{4})/(\d{2})/(\d{2}) \s (\d{2}:\d{2}:\d{2}) \s
                     26:                \[(\d+)\] \s (\S+) \s  (.+) \s (\d+)
                     27:                $#xms) {
                     28:
                     29:                $file =~ s/^.*$OBT->{BASENAME}\/?//;
                     30:
                     31:                my ($dir, $file) = $file =~ m#^(.*)/([^/]+)#;
                     32:                #print "$oper - ($last_dir) [$dir]/[$file]\n";
                     33:
                     34:                next unless $oper eq 'recv';
                     35:                next unless $size;
                     36:                next unless $dir;
                     37:
1.1       andrew     38:                if ($last_dir && $last_dir ne $dir) {
1.2       andrew     39:                        StartTorrent($last_dir);
1.1       andrew     40:                }
                     41:                $last_dir = $dir;
                     42:        }
1.2       andrew     43: }
1.7       andrew     44:
                     45: # Regen just the new ones now
                     46: sleep(1) while (keys %Kids > 0);
1.2       andrew     47: StartTorrent($last_dir);
                     48:
1.7       andrew     49: # after the new ones are done, regen all, just to make sure
                     50: sleep(1) while (keys %Kids > 0);
1.3       andrew     51: StartTorrent('skip');
                     52:
1.13      andrew     53: # and wait for it to finish
                     54: sleep(1) while (keys %Kids > 0);
                     55:
1.7       andrew     56: sub REAPER {
                     57:        my $child;
                     58:         while (($child = waitpid(-1,WNOHANG)) > 0) {
                     59:                $Kid_Status{$child} = $?;
                     60:                delete $Kids{$child};
                     61:        }
                     62:        $SIG{CHLD} = \&REAPER;  # still loathe sysV
1.14      andrew     63:
                     64:        StartTorrent('waiting');
1.7       andrew     65: }
1.3       andrew     66:
1.2       andrew     67: sub StartTorrent
                     68: {
                     69:        my $dir = shift;
1.3       andrew     70:        return undef unless $dir;
1.14      andrew     71:
1.7       andrew     72:        my $should_fork = 1;
                     73:
                     74:        if ($dir eq 'skip') {
1.8       andrew     75:                #$dir = '';
1.7       andrew     76:                %Need_Update = ();
                     77:                $should_fork = 0;
1.14      andrew     78:        }
                     79:        elsif ($dir eq 'waiting') {
                     80:                return if ! %Need_Update;
                     81:
                     82:                my $count = scalar keys %Need_Update;
1.15      andrew     83:                print "Have $count waiting torrents\n";
1.14      andrew     84:        }
                     85:        else {
1.15      andrew     86:                #print "Need to make torrent for '$dir'\n";
1.6       andrew     87:                $dir = $OBT->{BASENAME} . "/$dir";
1.7       andrew     88:                $Need_Update{$dir} = 1;
1.3       andrew     89:        }
                     90:
1.7       andrew     91:        if (keys %Kids > 0) {
                     92:                print "Not making torrents for $dir now, already running\n";
1.14      andrew     93:                return;
1.7       andrew     94:        }
1.3       andrew     95:
1.7       andrew     96:        my @now_update = keys %Need_Update;
                     97:        %Need_Update = ();
1.3       andrew     98:
1.7       andrew     99:        if ($should_fork) {
                    100:                defined(my $pid = fork) or die "Can't fork: $!";
1.3       andrew    101:
1.7       andrew    102:                if ($pid) {
                    103:                        $Kids{$pid} = 1;
1.14      andrew    104:                        return;
1.7       andrew    105:                }
1.3       andrew    106:
1.7       andrew    107:        }
                    108:
1.16    ! andrew    109:        print "\n";
1.7       andrew    110:        if (@now_update) {
                    111:                print "Making torrents for ", join(" ", @now_update), "\n";
                    112:        } else {
                    113:                print "Remaking all torrents\n";
1.8       andrew    114:                push @now_update, $dir;
1.7       andrew    115:        }
                    116:        exec($OBT->{DIR_HOME} . '/regen.sh', @now_update);
1.14      andrew    117:        exit;
1.1       andrew    118: }