Clownburner has asked for the wisdom of the Perl Monks concerning the following question:

O High Masters, I humbly implore you to share your wisdom:

I have apparently gained enough perl knowledge to become a serious threat to myself and others. I am trying to create a program that will fork a number of children, run a subroutine for each child (in parallel), and then, once all the children have returned, tally how many children come back successfully. (return = 1)

My logic is apparently flawed; my code will work as advertised *EXCEPT* the tallying part - each child keeps its own set of variables and I haven't figured out how to get the child to increment a parent variable.

I am constrained to avoid using additional CPAN modules if at all possible, since this has to be rolled out to a large number of client machines..

my $prox = scalar(@targets) -1;

my ($i, $ret, $pid, @pids);
   for ($i = 0; $i <= $prox; $i++) {
       if ($pid=fork) {
           push @pids, $pid;
           waitpid($pid,0);
       } elsif (defined $pid) {
           my $next = @targets[${i}];
           $ret = &check_status($next);
           if ($ret) { $avail ++; }
           exit;
       }
   }

my $success = ( $avail / scalar(@targets) ) * 100;
$success = sprintf('%.2f',$uptime);
print "$success% successful\n";

[download]
Also, I would like to know if there is a way to prevent this from becoming a fork() bomb if the @targets array contains a LOT of targets (it could easily contain 500+ targets), so how do I limit the number of children while still covering all the @targets?

I've looked through the documentation on fork() and wait() and waitpid() and searched this site, but I'm still not finding anything that helps.

I apologize in advance if I'm asking a blind-stupid question, I've been up for too long and my caffeine levels are dangerously low.

Signature void where prohibited by law.

Replies are listed 'Best First'.
Re: Tallying results from Forking processes...
by chipmunk (Parson) on Mar 21, 2001 at 09:37 UTC
    If I've got this right, your code is already prevented from being a fork bomb. Your script forks off a single child, then waits for that child to terminate, before forking off the next child. :) I don't think that's what you were looking for, though...

    According to the docs for wait and waitpid, the status of the child process is returned in $?. Thus, your child can exit with a status code to indicate whether it succeeded, and the parent can use that to determine whether or not to increment $avail.

    Here's a quick example based on some code from perlipc. (Please note that prior to 5.6.0 the relevant code sample in perlipc omitted the > 0 in the while condition.) 

    #!/usr/local/bin/perl -w

use strict;

use POSIX ":sys_wait_h";

my $avail;

sub REAPER {
    my $child;
    while ($child = waitpid(-1,&WNOHANG()) > 0) {
        $avail += ! $?;  # 0 means success, non-zero means failure
    }
    $SIG{CHLD} = \&REAPER;
}

$SIG{CHLD} = \&REAPER;

for (0..2,0..2) {
    if (fork) {
    } else {
        exit $_;
    }
}

print "$avail\n";

    [download]
[reply]
[d/l]
[select]
Re: Tallying results from Forking processes...
by merlyn (Sage) on Mar 21, 2001 at 07:49 UTC
[reply]
      merlyn's link is certainly comprehensive, and a great suggestion. If it turns out to be a bit daunting , I have a stripped down version which includes just the parent->child queue stuff in my Fork::Queue node.
[reply]
Success!
by Clownburner (Monk) on Mar 22, 2001 at 05:03 UTC
    Thanks in large part to Chipmunk's efforts, I was able to figure out a few optimizations to make this work without resorting to the 'full-blown forking process handler' approach. Perhaps this is oversimplified and I missed something important; if that's the case, please please let me know before I put this code into production.

    After correcting the logic to use the child status ($?) to increment/not increment the counter for status, I fixed the forking so that the parent wouldn't wait for each child, to improve speed. To prevent the resulting fork()bomb, I devised a clever (to me) way to subdivide the array @targets into chunks that I could use to get exactly as many clients as I needed, but no more. I then used a global variable ($i) to index the array so that each child got called on a separate target, and no target got checked more than once.

    If anyone has any further optimizations, please share!

    
$maxprocs = 50;

my $prox = int(scalar(@targets)/$maxprocs);
my $prox_r = int(scalar(@targets)%$maxprocs);
my $i = 0;

if ($prox)    # call the forking routine as many times as required to 
+get most of the targets
 {
  for ( 1 .. $prox ) 
   {
    &breed($maxprocs);  
   }
 }
if ($prox_r)  # Then call the forking routine but this time only enoug
+h to catch the modulo
 {
  &breed($prox_r);
 }

# Calculate results and print to STDOUT
my $success = ( $main::avail / scalar(@targets) ) * 100;    # return r
+esults as a percentage
$success = sprintf('%.2f',$success);                        # rounded 
+to 2 decimals 
print "$success\n";


#########################
sub breed ($)
#########################
{
    my $loop = shift;
    for ( 1 .. $loop )      #make a bunch of kids
     {
       if ($pid=fork) {
           push @pids, $pid;
           $i ++; 
       } elsif (defined $pid) {
           my $next = @targets[${i}];
           &check_status($next);
           exit;
       }
     }
   foreach my $childpid (@pids)   # wait for all kids to return before
+ continuing
   {
    waitpid($childpid, 0);
    $main::avail += ! $?;   # Increment the master counter, 0 means su
+ccess, non-zero means failure
   }
}

    [download]
    Signature void where prohibited by law.
[reply]
[d/l]
Minor Correction:
by Clownburner (Monk) on Mar 21, 2001 at 07:24 UTC
    The following line of code is incorrect: 
    $success = sprintf('%.2f',$uptime);

    [download]
    It should read 
    $success = sprintf('%.2f',$success);

    [download]
    There was a Copy/Paste error in the interface between the chair and keyboard. ;-)

    Signature void where prohibited by law.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom