Return to NewTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

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