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

I've got a program which is irritating me because of unreliable signals. If you run the program below then you'll probably see that it never finishes because some of the SIGCHLD signals have go missing due to the signal handler being engaged when they are issued. I think that POSIX and sigation is the way to go. In the spirit of Laziness (one of the great perl virtues ;-) - has anyone done this before? (I've been running this under Linux 2.2.16 and perl 5.6.0) 
use strict;
$|=1;

my $forked = 0;
$SIG{CHLD} = \&REAPER;          # set handler for fork

for (1..10)
{
    my $pid = fork();
    die "Fork failed" unless defined $pid;
    if ($pid == 0)
    {
        print "Hello $$\n";
        sleep 1;
        print "Bye $$\n";
        exit;
    }
    else
    {
        $forked++;
        print "Started child $pid\n";
    }
}

print "Waiting for children to finish..";
while ($forked > 0)
{
    print "[$forked] ";
    sleep 1;
}
print "Done\n";

exit;

sub REAPER
{
    my $pid = wait;
    $SIG{CHLD} = \&REAPER;      # reinstall for sysV (not needed)
    print "Finished child process $pid" . ($? ? " with exit $?" : "") 
+. "\n";
    $forked--;
}

[download]

Replies are listed 'Best First'.
Re: POSIX and sigaction
by chromatic (Archbishop) on Aug 24, 2000 at 19:57 UTC
    You could put a simple waitpid call in your while loop there, just to hang around while there's still a kid out there. I didn't even need the POSIX module: 
    while ($forked > 0) {
    print "[$forked] ";
    last if (waitpid(-1,0) == -1);
    sleep 1;
}

    [download]
    That's not a beautiful solution, though. Here's another attempt: 
    #!/usr/bin/perl -w

use strict;
$|=1;

my %kids;
$SIG{CHLD} = \&REAPER;          # set handler for fork

for (1..10) {
    my $pid = fork();
    die "Fork failed" unless defined $pid;
    if ($pid == 0) {
        print "Hello $$\n";
        sleep 1;
        print "Bye $$\n";
        exit;
    } else {
        $kids{$pid} = 1;
        print "Started child $pid\n";
    }
}

foreach my $kid (keys %kids) {
    print "Waiting for [$kid]:\n";
    my $val;
    do {
        $val = waitpid($kid, 0);
    } until $val == -1;
    delete $kids{$kid};
}

print "Done\n";
exit;

sub REAPER {
    my $pid = wait;
    $SIG{CHLD} = \&REAPER;      # reinstall for sysV (not needed)
    print "Finished child process $pid" . ($? ? " with exit $?" : "") 
+. "\n";
    delete $kids{$pid};
}

    [download]
    Not perfect, but you get the chance to be more specific on what you're waiting for.
[reply]
[d/l]
[select]
Re: POSIX and sigaction
by merlyn (Sage) on Aug 24, 2000 at 18:40 UTC
    I've finally vowed never to use a native Perl signal handler for anything. I now put something like Event in those programs that need to catch signals. Of course, you've got to be comfortable with turning your program into an event-driven loop to use it, but once you do, no more problems with signals!

    -- Randal L. Schwartz, Perl hacker

[reply]
RE: POSIX and sigaction
by mikfire (Deacon) on Aug 24, 2000 at 19:57 UTC
    I do most of my work on FreeBSD and haven't access to a Linux box. This is important because you reinstall the handler. That is an *old* SysV thing. Are you sure it is necessary? I had endless troubles using code like this until I stopped reinstalling the handler.

    Second, why are you using a handler? It seems to me you are not ( at least in this example ) gaining anything by installing a handler. You want the parent to handle reaping the children. Signal handlers are really only useful when you want something to happen outside the scope of the parent process and that "something" needs to happen immediately. I do not gather you are working like that. If a child waits a few seconds for you to reap it, will there be any harm?

    This snippet is from a code that spawns N children and gives them something to do from a job queue. When a child finishes, ie exits, I simply spawn another child off. Note the loop at the end to wait for the last N children to finish. 

    while( @jobq ) {
    if ( $counter < $num_children ) {
        &SPAWN( $ref );
    }
    else {
        do {
           sleep 5;
           $dpid = waitpid( -1, 1 );
        } until $dpid;
        last if ( $dpid == -1 );  # No children left
        printf "%s has finished, spawning next child (%d left)\n", $tr
+acker{$dpi
d}, scalar @jobq;
        &SPAWN( $ref );
    }
}

do {
    sleep 5;
    $dpid = waitpid( -1, 1 );
    printf("%s has finished\n", $tracker{$dpid}) if(defined( $tracker{
+$dpid} )
    );
} until $dpid == -1;

    [download]

    mikfire

[reply]
[d/l]

Back to Seekers of Perl Wisdom