Return to NewTorrents.pl CVS log

Up to [local] / openbsd / OpenBSDTorrents

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

1.1       andrew      1: #!/usr/bin/perl -T
1.13    ! andrew      2: #$RedRiver: NewTorrents.pl,v 1.12 2007/10/01 20:17:23 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.13    ! andrew     22:        if (my ($message, $file) = m#(.*)\s+\`([^']+)'#) {
        !            23:                next if $message eq 'Mirroring directory';
1.10      andrew     24:                next if $message eq 'Making directory';
                     25:
                     26:                my $dir = '';
                     27:                if ($file =~ m#^(.*)/([^/]+)#) {
                     28:                        ($dir, $file) = ($1, $2);
                     29:                }
1.13    ! andrew     30:                #print "$message - ($last_dir) $dir - $file\n";
        !            31:                print "$message - $dir - $file\n";
1.1       andrew     32:                if ($last_dir && $last_dir ne $dir) {
1.2       andrew     33:                        StartTorrent($last_dir);
1.1       andrew     34:                }
                     35:                $last_dir = $dir;
                     36:        }
1.2       andrew     37: }
1.7       andrew     38:
                     39: # Regen just the new ones now
                     40: sleep(1) while (keys %Kids > 0);
1.2       andrew     41: StartTorrent($last_dir);
                     42:
1.7       andrew     43: # after the new ones are done, regen all, just to make sure
                     44: sleep(1) while (keys %Kids > 0);
1.3       andrew     45: StartTorrent('skip');
                     46:
1.13    ! andrew     47: # and wait for it to finish
        !            48: sleep(1) while (keys %Kids > 0);
        !            49:
1.7       andrew     50: sub REAPER {
                     51:        my $child;
                     52:         while (($child = waitpid(-1,WNOHANG)) > 0) {
                     53:                $Kid_Status{$child} = $?;
                     54:                delete $Kids{$child};
                     55:        }
                     56:        $SIG{CHLD} = \&REAPER;  # still loathe sysV
                     57: }
1.3       andrew     58:
1.2       andrew     59: sub StartTorrent
                     60: {
                     61:        my $dir = shift;
1.3       andrew     62:        return undef unless $dir;
1.12      andrew     63:        $dir =~ s/^.*$OBT->{BASENAME}\///;
1.2       andrew     64:
1.13    ! andrew     65:        print "Starting '$dir'\n";
1.7       andrew     66:        my $should_fork = 1;
                     67:
                     68:        if ($dir eq 'skip') {
1.8       andrew     69:                #$dir = '';
1.7       andrew     70:                %Need_Update = ();
                     71:                $should_fork = 0;
                     72:        } else {
1.6       andrew     73:                $dir = $OBT->{BASENAME} . "/$dir";
1.7       andrew     74:                $Need_Update{$dir} = 1;
1.3       andrew     75:        }
                     76:
1.7       andrew     77:        if (keys %Kids > 0) {
                     78:                print "Not making torrents for $dir now, already running\n";
                     79:                return undef;
                     80:        }
1.3       andrew     81:
1.7       andrew     82:        my @now_update = keys %Need_Update;
                     83:        %Need_Update = ();
1.3       andrew     84:
1.7       andrew     85:        if ($should_fork) {
                     86:                defined(my $pid = fork) or die "Can't fork: $!";
1.3       andrew     87:
1.7       andrew     88:                if ($pid) {
                     89:                        $Kids{$pid} = 1;
                     90:                        return undef;
                     91:                }
1.3       andrew     92:
1.7       andrew     93:        }
                     94:
                     95:        if (@now_update) {
                     96:                print "Making torrents for ", join(" ", @now_update), "\n";
                     97:        } else {
                     98:                print "Remaking all torrents\n";
1.8       andrew     99:                push @now_update, $dir;
1.7       andrew    100:        }
                    101:        exec($OBT->{DIR_HOME} . '/regen.sh', @now_update);
1.1       andrew    102: }