[BACK]Return to NewTorrents.pl CVS log [TXT][DIR] Up to [local] / openbsd / OpenBSDTorrents

Diff for /openbsd/OpenBSDTorrents/NewTorrents.pl between version 1.6 and 1.15

version 1.6, 2005/04/07 00:00:31 version 1.15, 2010/03/03 18:23:46
Line 1 
Line 1 
 #!/usr/bin/perl -T  #!/usr/bin/perl -T
 #$Id$  #$RedRiver: NewTorrents.pl,v 1.14 2009/10/20 19:03:25 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use diagnostics;  use diagnostics;
Line 7 
Line 7 
 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;  
   
 # *** This requires --log-format="%t [%p] %o %f %l" on the rsync command  
   
 my $last_dir = '';  my $last_dir = '';
 while (<>) {  while (<>) {
           #print;
         chomp;          chomp;
         if (my ($year,  $mon,  $mday,   $time,               $pid,   $oper, $file, $size) =          # *** This requires --log-format="%t [%p] %o %f %l" on the rsync command
             m#^(\d{4})/(\d{2})/(\d{2}) (\d{2}:\d{2}:\d{2}) \[(\d+)\] (\S+) (.+) (\d+)$# ) {          if (my ($year,  $mon,   $mday,     $time,
                 #print "($year, $mon, $mday, $time, $pid, $oper, $file, $size)\n";                  $pid,        $oper,    $file,  $size) = m#^
                 my ($dir, $file) = $file =~ m#^(.*)/([^/]+)#;                  (\d{4})/(\d{2})/(\d{2}) \s (\d{2}:\d{2}:\d{2}) \s
                 #print "$dir - $file\n";                  \[(\d+)\] \s (\S+) \s  (.+) \s (\d+)
                   $#xms) {
   
                   $file =~ s/^.*$OBT->{BASENAME}\/?//;
   
                   my ($dir, $file) = $file =~ m#^(.*)/([^/]+)#;
                   #print "$oper - ($last_dir) [$dir]/[$file]\n";
   
                   next unless $oper eq 'recv';
                   next unless $size;
                   next unless $dir;
   
                 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');
   
   # and wait for it to finish
   sleep(1) while (keys %Kids > 0);
   
   sub REAPER {
           my $child;
           while (($child = waitpid(-1,WNOHANG)) > 0) {
                   $Kid_Status{$child} = $?;
                   delete $Kids{$child};
           }
           $SIG{CHLD} = \&REAPER;  # still loathe sysV
   
           StartTorrent('waiting');
   }
   
 sub StartTorrent  sub StartTorrent
 {  {
         my $dir = shift;          my $dir = shift;
         return undef unless $dir;          return undef unless $dir;
   
           my $should_fork = 1;
   
         if ($dir ne 'skip') {          if ($dir eq 'skip') {
                   #$dir = '';
                   %Need_Update = ();
                   $should_fork = 0;
           }
           elsif ($dir eq 'waiting') {
                   return if ! %Need_Update;
   
                   my $count = scalar keys %Need_Update;
                   print "Have $count waiting torrents\n";
           }
           else {
                   #print "Need to make torrent for '$dir'\n";
                 $dir = $OBT->{BASENAME} . "/$dir";                  $dir = $OBT->{BASENAME} . "/$dir";
         } else {                  $Need_Update{$dir} = 1;
                 $dir = '';  
         }          }
   
         # 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;
           }
   
         #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;
                   }
   
         #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($OBT->{DIR_HOME} . '/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);
           exit;
 }  }
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.15
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>