Win32 fork() example with reaping

Here's the deal: you're on win32, you need to fork() and you're using Perl. Since version 5.6, win32 Perl has had fork() emulation. That's good. It's emulation (accomplished at the interpreter level with threading), so standard Unix tricks like using a signal handler to reap children and control the number of child process don't work. That's bad.

Here then is my Win32 Perl recipe for the week: Limiting forked child "processes" under Win32 Perl (versions 5.6 and higher).

use strict;
use POSIX ":sys_wait_h";
use constant MAX_KIDS => 4;
 
my (%children, $quit) = ((), 0);
print "[$$] Entering main loop\n";
while (!$quit) {
  reap(\%children);
  
  if ((keys %children) <= MAX_KIDS) {
    print "[$$] Forking child $_\n";
    if (my $pid = fork()) {
      $children{$pid} = 1;
    } else {
      do_child();
      exit;
    }
  } else {
    $quit = 1;
  }
 
  sleep(1);
}
 
# reap existing kids
while (keys %children) {
  reap(\%children);
  sleep(1);
}
 
print "All children reaped\n";
 
#--------
# sub 
#--------
sub reap {
  my ($kids) = @_;
  for (keys %{$kids}) {
    print "[$$]child '$_' reapable?\n";
    next if waitpid($_,WNOHANG()) != -1;
    print "[$$]child '$_' reaped\n";
    delete $kids->{$_};
  }
}
  
sub do_child {
  sleep(1) for 0..10;
  print "[$$] done\n";
}

Note that you can do other work in the main reaping loop.

The main loop is really the service state loop for a Win32 service. Also note that reaping the child "processes" isn't strictly necessary. Not only are the children not real processes (they are interpreter threads), but also no zombies can be created if the parent process exits without calling wait(). All child "processes" will be terminated with the parent. So you've got that going for you.

See David Roth's web site, books or articles for more excellent details on the devilish art of creating Win32 services with Perl.

[Original use.perl.org post and comments. Minor cleanup on 11/30/2007.]