--- Chip Cuntz <[EMAIL PROTECTED]> wrote:
> . . .
> boxes in the network to do things.  Since these functions are
> essentially running on "other processors" I would like to
> spawn/fork/thread two of them and wait for both there completion. 
> . . .
> What I am looking for is code snippets, an example someone has seen
> or for someone to give me a clue where to start.  Any ideas would be
> appreciated.

Here's an old script we use to flatten out loads on our box.
No warranties, and I haven't scrubbed it. (it's old, but it works so
far =o)  But here it is; it might give you some ideas.

(To the list, my apologies, but I'm on a short schedule today, and
haven't time to properly explain the bulk of the code. I make no
pretense that this one is necessarly *good* code. I just hope someone
can benefit from the example. Feel free to write me with questions, but
I'm just cut&pasting this one. mea culpa)

Code:
======
#!/dart10/perl5/bin/perl -w
use strict;
# setup
die "\n  Use: $0 CommandFile Procs {die|continue}

  $0 is a process-to-CPU spooler.
  Reads CommandFile and treats each line as a command to be run.
  Forks each command as a background child coprocess (don't use &).
  Procs is the number of coprocesses $0 will spawn.
  It waits for (any) one to finish, and runs another.
  Commands in Commandfile PROBABLY WON'T BE RUN IN LISTED ORDER.
  Each new line will be started as soon as any older one finishes,
  but with more than one running, the order is UNPREDICTABLE.
  'die' or 'continue' tell $0 how to treat errs.
  For 'die', any error return code shuts $0 down.
  'continue' will produce a notice, but processing will not stop.
  $0 now allows pipelines and per-process
  I/O redirections, but BE CAREFUL! It cannot check the return code
  of processes embedded in a pipeline!
" unless ($ARGV[2]);

die "$ARGV[0] is not a command file^G.\n" unless -e $ARGV[0] and -f _;
die "Argument 2 ($ARGV[1]) is not a valid numeric
     for simultaneous processes^G\n" if $ARGV[1] =~ /\D/
     or $ARGV[1] > 12;
die "^GInvalid error option $ARGV[2] (should be 'die' or 'continue'\n"
   unless $ARGV[2] =~ /^die|continue$/;

my(@CMD,$cmd,%cmd,$pid,$err);
open(CMD,$ARGV[0]) or die "unable to open CommandFile $ARGV[0]";
@CMD = <CMD>;
close CMD;

sub spawn () {
   return 0 unless @CMD;
   unless ($cmd = shift @CMD) { # read next command from cmdfile
      warn "\nDone with command file $ARGV[0]\n";
      return undef @CMD;
   }
   chomp $cmd;
   if ($cmd =~ /[&]/o) {
      warn "\nIllegal character '&' found in command '$cmd';\n",
         "$0 forks all jobs as background child coprocessess;\n";
      $cmd =~ s/[&]/ /go;
      warn "Removed ampersand, Executing  '$cmd'\n\n";
   }
   exec $cmd unless $pid=fork; # fork new process for cmd
   if (defined $pid) {
      warn "\n$cmd\n\tforked as PID $pid ",
         scalar localtime(time),"\n";
   } else {
      die "\n^GFailed fork for $cmd\n\t-- ending.\n";
   }
   $cmd{$pid} = $cmd;
   return $pid;
}

sub chk ($) {
   $pid = shift;
   return unless $pid > 0; # wait returns -1 when no more children
   $err = $?>>8;
   if ($err) {
      die "\n >>> ERROR $err: $pid $cmd{$pid}\n\treturned $err! ",
         scalar localtime(time),"\n" if $ARGV[2] eq 'die';
      warn "\n >>> NOTICE: $pid '$cmd{$pid}' returned $err!\n";
   }
   if (defined $cmd{$pid}) {
      warn "\n$pid $cmd{$pid}\n\treturned $err ",
         scalar localtime(time),"\n";
   } else {
      warn "\nWait returned unknown process $pid.\n";
   }
   delete $cmd{$pid}; # remove from hash of running processes
   $pid;
}
END {
   if (my @cmd = keys %cmd) { # not done yet.
      my $msg = '';
      for $pid (sort @cmd) { $msg .= "\t$pid\t$cmd{$pid}\n"; }
      warn '='x65, "\n$0 processing interrupted!\n",
           "processes currently underway:\n",
           "$msg\n$0:Abandoning program!\n",'='x65,"\n ";
   }
}
sub abort { print shift,":"; exit 1; } # for signal handling
$|=1;     # autoflush stdout -- doubt children inherit it
%SIG = (
         HUP  => 'IGNORE', # just because it seems only reasonable!
         INT  => \&abort,
         QUIT => \&abort,  # can these inherit also? should they?      
            TERM => \&abort,
);

# spawn one process for each requested
foreach (1..$ARGV[1]) { &spawn; }

# start another when each exits till all are run
do { &chk(wait); } while (&spawn);

# report for each of the last child processes
sleep 1 while &chk(wait);

exit; # done! yayy!


__________________________________________________
Do You Yahoo!?
Yahoo! Auctions - buy the things you want at great prices
http://auctions.yahoo.com/

Reply via email to