Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Concurrent Processes

by QM (Vicar)
on Oct 21, 2003 at 23:18 UTC ( #301106=note: print w/ replies, xml ) Need Help??


in reply to Concurrent Processes

for ($i=0; $i<$g; $i++)

Idiomatically, this is

foreach my $i (0..$g)

Later on you have

pipe ($rh, $wh)
...but then in the parent...

close ($wh);
...or in the child...

close ($rh);

Why do you need a 2-way pipe just to close one of them down?

Here's a generic form of parallel process dispatcher that I worked up a few years ago. I'm sure there some things that could be done better. I've reworked it to be generic, but I can't completely test it here (the "-|" fails where I am now).

#!/your/perl/here use strict; use warnings; use IO::Handle; use POSIX qw(:signal_h :errno_h :sys_wait_h ); use Getopt::Long; # define option names and defaults our $PARENT_OPT = q/parent/; our $CHILD_OPT = q/child/; our $INTERVAL_OPT = q/interval/; our $PARENT_OPT_SHORT = substr( $PARENT_OPT, 0, 1 ); our $PARENT = 5; # seconds our $CHILD = 5; # seconds our $INTERVAL = 0; # seconds our $CHILD_COMMAND = 'echo '; # note that =f takes a real, but integers are also allowed GetOptions( "$PARENT_OPT=f" => \$PARENT, "$CHILD_OPT=f" => \$CHILD, "$INTERVAL_OPT=f" => \$INTERVAL ) or usage(); @ARGV or usage(); ############################################## sub usage { die <<"USAGE"; usage: $0 [-$PARENT_OPT time] [-$CHILD_OPT time] [-$INTERVAL_OPT time] description: $0 performs \'${CHILD_COMMAND} machine\' for all machine names given on the command line -$PARENT_OPT time changes the default total time (${PARENT}s) for the parent -$PARENT_OPT time changes the default machine response time (${CHILD}s) -$INTERVAL_OPT time changes the default request interval (${INTERVAL}s) -help -? prints this message (any unrecognized option will do the same +) Note that unique abreviations can also be used. [e.g., -$PARENT_OPT_SHORT for $PARENT_OPT] USAGE } # sub usage ############################################## # let child timeout control parent timeout $PARENT = $CHILD if $PARENT < $CHILD; our %pid_to_name = (); # exists, but empty our @names = @ARGV; # fill as desired # signal setup $SIG{ALRM} = \&ALARM_PARENT; $SIG{INT} = $SIG{HUP} = \&REAP_ALL; $SIG{CHLD} = \&REAPER; # set parent alarm # (not just for time limit, also for pathological fork problems) alarm $PARENT; STDERR->autoflush( 1 ); ################################################## # fork children FORK: foreach my $name ( @names ) { # need 'no strict "refs"' for open( $var, ... ) # better way to do this? no strict "refs"; if ( my $pid = open( $name, "-|" ) ) # fork a child { # parent code here $pid_to_name{ $pid } = $name; # wait between requests, if needed select undef, undef, undef, $INTERVAL; } elsif ( not( defined( $pid ) ) ) { # "open" didn't fork, try again warn "Failed to fork on $name, retrying...\n"; redo FORK; } else # child code here { # alarm handler for child different from parent $SIG{ALRM} = \&ALARM; alarm $CHILD; STDOUT->autoflush( 1 ); # flush output STDERR->autoflush( 1 ); # place child stuff here, including write to STDOUT my $catch = `${CHILD_COMMAND}$name`; warn "[$name] $?" if $?; if ( length( $catch ) ) { print "=" x 10, "${CHILD_COMMAND}$name", "=" x 10, "\n"; print $catch; print "-" x 30, "\n"; } exit; # exit from child } } # foreach $name ( @names ) # while there are children left, wait for alarm or child while ( keys %pid_to_name ) { sleep; # to periodically do something else while waiting, # give sleep a value above (or use select), and put code here } exit; # exit from parent ################################################## sub REAPER { my $pid = waitpid( -1, &WNOHANG ); # WNOHANG from POSIX if ( $pid == -1 ) { # no children waiting, ignore it } elsif ( WIFEXITED( $? ) ) # WIFEXITED from POSIX { my $name = $pid_to_name{ $pid }; my @catch = <$name>; close( $name ); print @catch; warn "\t\t[$name] waiting, reaped in REAPER\n"; delete( $pid_to_name{ $pid } ); # only keep the living childre +n } else { # false alarm my $name = $pid_to_name{ $pid }; warn "\t\t[$name] false alarm waiting, untouched in REAPER\n"; } $SIG{CHLD} = \&REAPER; # in case of unreliable signals } # sub REAPER ################################################## sub REAP_ALL { foreach my $child ( keys %pid_to_name ) { my $pid = waitpid( $child, &WNOHANG ); # WNOHANG from POSIX if ( WIFEXITED( $? ) ) # WIFEXITED from POSIX { my $name = $pid_to_name{ $child }; my @catch = <$name>; close( $name ); print @catch; warn "\t\t[$name] waiting, reaped in REAP_ALL\n"; } else { # child not waiting, close it anyway my $name = $pid_to_name{ $pid }; close( $name ); warn "\t\t[$name] not waiting, reaped anyway in REAP_ALL\n +"; } } # foreach $child exit; # exit parent } # sub REAP_ALL ################################################## sub ALARM_PARENT { warn "Parent timed out ${PARENT}s, reaping children...\n"; REAP_ALL(); } # sub ALARM_PARENT ################################################## sub ALARM # for child processes { STDOUT->autoflush( 1 ); my $name = $pid_to_name{ $$ }; warn "\t\t[$name] timed out ${CHILD}s\n"; close( STDOUT ); exit; } # sub ALARM __END__

-QM

--

Quantum Mechanic


Comment on Re: Concurrent Processes
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://301106]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (13)
As of 2014-10-20 10:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (75 votes), past polls