can a perl child wait for another perl child to finish? - perl

Question

So I have a program where i spawn off some children who do some useful tasks. I then spawn off another child who needs to wait for the first children to stop before doing its work. The parent program then continues running and at the end waits for the last forked child to stop.
I'm getting an issue where the child who needs to wait on the others doesn't.
use strict;
use warnings;
use diagnostics;
my $pid1;
my $child1 = fork();
if ($child1) {
# parent
#print "pid is $pid, parent $$\n";
$pid1 = $child1;
} elsif ($child1 == 0) {
# child1
# do something
sleep 20;
print "Child1\n";
exit 0;
} else {
die "couldnt fork: $!\n";
}
my $pid2;
my $child2 = fork();
if ($child2) {
# parent
#print "pid is $pid, parent $$\n";
$pid2 = $child2;
} elsif ($child2 == 0) {
# child2
# wait for child1 to finish
my $tmp = waitpid($pid1, 0);
# do something else
print "Child2\n";
exit 0;
} else {
die "couldnt fork: $!\n";
}
# do more stuff
# wait for child2 to finish
my $tmp = waitpid($pid2, 0);
Is there an easy way to do this? Possibly without having to wrap the first child in the second?

Answer 1

In Unix-like systems, a given process can only wait for its own children to die. It can't wait for siblings, ancestors or grandchildren to die.

Answer 2

Spawn one child, have that process spawn sub-child processes, and then wait for them to finish before continuing in the first child process.
Then have the parent do its work and wait on the child process when it's ready to wait.

Answer 3

The easy way to do this is with Forks::Super.
use Forks::Super;
my $child1 = fork();
if ($child1 != 0) {
# ... parent code ...
} else {
# ... child code ...
exit;
}
my $child2 = fork {
depend_on => $child1,
on_busy => 'queue',
sub => sub {
# ... code to execute in 2nd child ...
}
};
# ... more code to run in the parent ...
# ... and at the end of the program:
waitall;
In Forks::Super, waitpid is still called in the parent (behind the scenes). But when the first child is finished, Forks::Super will know it is time to start launch the second child process in the background.

Answer 4

Assuming your perl has semop and
friends, you could use System V semaphores for synchronization among the children. See
below for a working example program.
We begin with the usual front matter. Rather than calling the low-level
semaphore operations directly, the code uses the built-in
IPC::SysV and
IPC::Semaphore modules.
#! /usr/bin/env perl
use strict;
use warnings;
use IPC::Semaphore;
use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT /;
This program separates child processes into the two stages. Children in
the first stage run to completion, performing their processing with no
synchronization concerns. We can have arbitrarily many of these.
We have a single second-stage process, but it executes after all
first-stage children have finished.
Below are simple placeholder implementations.
# how many other children the last child must wait for
my $FIRST_STAGE_CHILDREN = 2;
sub first_stage {
my($id) = #_;
print "[$$] hello from child $id\n";
sleep rand 10;
print "[$$] child $id done\n";
}
sub second_stage {
print "[$$] hello from second-stage child!\n";
}
To implement synchronization between the first and second stages, the
program creates a set of semaphores whose size equals the number of
first-stage children. When a first-stage child completes, the program
releases the particular semaphore corresponding to that child.
my $sem = IPC::Semaphore->new(
IPC_PRIVATE, $FIRST_STAGE_CHILDREN,
S_IRUSR | S_IWUSR | IPC_CREAT)
or die "$0: failed to create semaphore: $!";
As we will see later, the second-stage child waits on his brethren by
attempting to decrement their semaphores. By starting the value at zero,
when the second-stage child attempts these decrements, the OS will put
the child to sleep because. Only after all first-stage children have
exited and released their semaphores will the system unblock the
second-stage child.
# start in blocked state
$sem->setall((0) x $FIRST_STAGE_CHILDREN);
First we fork the first-stage children. In this design, the parent
process does as much bookkeeping as possible. This keeps the definition
of first_stage and second_stage simple. Also, if a first-stage child
somehow exited without releasing its semaphore, the second stage would
have no hope of running.
my %kids;
foreach my $id (0 .. $FIRST_STAGE_CHILDREN - 1) {
my $pid = fork;
die "$0: fork: $!" unless defined $pid;
if ($pid) {
++$kids{$pid};
}
else {
first_stage $id;
$sem->op($id, 1, 0); # release
exit 0;
}
}
Now we fork the second-stage child. Important: although the code
performs an operation on multiple semaphores, this happens atomically,
that is, either it works for all of them or none of them. In no
observable state will it appear that the second stage was able to grab
any fewer than all of the first-stage semaphores. This is an important
property. In more complex systems, haphazard onesie-twosie taking and
releasing will result in deadlock.
my $pid = fork;
die "$0: fork: $!" unless defined $pid;
if ($pid) {
++$kids{$pid};
}
else {
# block waiting on all first-stage children
my #op = map +($_, -1, 0), 0 .. $FIRST_STAGE_CHILDREN - 1;
$sem->op(#op);
second_stage;
exit 0;
}
Finally, the parent process waits for all children to complete.
do {
$pid = waitpid -1, 0;
print "[$$] reaped $pid\n";
warn "$0: unknown child $pid" unless delete $kids{$pid};
} while $pid > 0 && keys %kids;
Sample output is below. It’s more interesting to watch live where you can see the pauses.
[18389] hello from child 0
[18390] hello from child 1
[18390] child 1 done
[18388] reaped 18390
[18389] child 0 done
[18391] hello from second-stage child!
[18388] reaped 18389
[18388] reaped 18391