Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
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 romping around the Monastery: (6)
As of 2015-07-08 04:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (94 votes), past polls