Re^2: Fork and creating a thread exits the process

[marioroy]

Hi fluks,

The following are modified threads and fork demonstrations. They work on Linux including 32-bit and 64-bit Windows.

For threads, one may need to increase stack_size depending on the application. Not reaping threads will likely cause recent threads to not complete and exit prematurely. Ditto for fork on the Windows platform. Tip: Loading IO::Handle before spawning workers is beneficial. This saves workers from having to load this particular module and dependencies individually.

threads

use strict;
use warnings;

use threads (stack_size => 64*4096);
use IO::Handle (); # extra stability

my @car_links = (1..200);
my ($username, $password, $fh, @known_cars);

sub reserve_car { }
sub write_url_to_known_cars { }

my $count = 0;

for my $c (@car_links) {
    CREATE:
    my $thr = threads->create(sub {
        # Reserve for 10 seconds total.
        for (1..1) {
            reserve_car($c, $username, $password);
            sleep 10;
        }
        threads->exit(0);
    });
    if (!defined $thr) {
        while () {
            $count++;
            warn "cannot spawn thread, waiting -- $count\n";
            my $thr_exited = 0;
            for my $thr (threads->list(threads::joinable)) {
                $thr->join;
                $thr_exited = 1;
            }
            $thr_exited ? last : sleep(1);
        }
        goto CREATE;
    }

    push @known_cars, $c;
    write_url_to_known_cars($c, $fh);
}

print "reaping threads\n";
$_->join for threads->list;

fork

use strict;
use warnings;

use POSIX ":sys_wait_h";
use IO::Handle (); # extra stability

my @car_links = (1..100);
my ($username, $password, $fh, @known_cars);

sub reserve_car { }
sub write_url_to_known_cars { }

my $count = 0;
my %pids;

for my $c (@car_links) {
    FORK:
    my $pid = fork();
    if (!defined $pid) {
        while () {
            $count++;
            warn "cannot spawn child, waiting -- $count\n";
            my $child_exited = 0;
            for my $pid (keys %pids) {
                # support negative PID value on Windows
                my $ret = waitpid($pid, WNOHANG);
                if ($ret < -1 || $ret > 0) {
                    delete $pids{$pid};
                    $child_exited = 1;
                }
            }
            $child_exited ? last : sleep(1);
        }
        goto FORK;
    }
    elsif ($pid == 0) {
        # Reserve for 10 seconds total.
        for (1..1) {
            reserve_car($c, $username, $password);
            sleep 10;
        }
        exit;
    }
    else {
        $pids{$pid} = undef;
    }

    push @known_cars, $c;
    write_url_to_known_cars($c, $fh);
}

print "reaping children\n";
waitpid($_, 0) for (keys %pids);

Regards, Mario