--- "Ronald J. Yacketta" <[EMAIL PROTECTED]> wrote:
> Paul,
> anyword on that skeleton code you mentioned ???
This is actually a process-to-CPU "spooler" I wrote a while back for
load-balancing on our production data processing machine. It's worked
reasonably well, and might provide some good skeleton code for dividing
those logfiles up to children.
Feel free to offer refinements, folks. My style has changed a bit since
this was written, but I still have plenty left to learn. =o)
============================================================
#!/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.\n" unless -e $ARGV[0] and -f _;
die "Argument 2 ($ARGV[1]) is not a valid numeric
for simultaneous processes\n" if $ARGV[1] =~ /\D/
or $ARGV[1] > 12;
die "Invalid 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 "\nFailed 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: $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;
%SIG = (
HUP => 'IGNORE', # just because it seems only reasonable!
INT => \&abort,
QUIT => \&abort, # can kids inherit these? should they?
TERM => \&abort,
);
# process
# 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!?
Spot the hottest trends in music, movies, and more.
http://buzz.yahoo.com/
