Perl fork() example with multiple child processes and a way to stop the process in case child processes are stuck

nohang_forking.pl

use strict;
use warnings;
use POSIX qw( WNOHANG );

my $spawn_processes = 5;
my $forked = 0;
my ($err, $success) = (0, 0);
my $local_id = 0;
print "($$) parent has started\n";

foreach(1..$spawn_processes) {
    my $child_pid = fork();
    if(defined $child_pid && $child_pid > 0) {
        $forked++;
        $local_id++;
    } elsif(defined $child_pid){
        ## Child
        print "($$) has started, local_id = $local_id\n";
        
        ## Let's simulate stuck process by letting one process sleep for 6000 seconds
        my $sleep_sec = $local_id == 2 ? 6000: 10 - $local_id;
        sleep($sleep_sec);
        ## Never forget to exit since the finalization part
        ## should only be executed by the parent process
        exit;
    } else {
	$err++;
    }
}

my $stopped = 0;

while($forked > 0) {
    ## fetch stop criterion here
    $stopped = fetch_stop();
    if($stopped->[0][2] == 1) {
        last;
    }

    my $pid = waitpid(-1, WNOHANG);
    if($pid > 0) {
        print "($$) $pid has finished\n";
        $forked--;
        $success++;
    } elsif($pid == -1) {
        print "($$) $pid has crashed\n";
        $forked--;
        $err++;
    }
    sleep(1);
}

if($stopped) {
    print("Stop signal received: parent $$ has been stopped. Remember the zombie children.");
} else {
    print "$$ parent process has finished with:\n";
    print " -> $success child processes finishing just fine\n";
    print " -> $err child processes dying or getting stuck\n";
}