package Forking::Amazing;

sub run ($&&@)
  {
  my ( $maxforks, $childcallback, $resultcallback, @ids ) = @_;

  use Storable qw( freeze thaw );
  use IO::Select;
  my %fh2id;
  my $sel = IO::Select->new;
  while( @ids or $sel->count ) # unstarted or active
    {
    while( @ids and $sel->count < $maxforks ) # start all forks allowed
      {
      my $id = shift @ids;
      if( open my $fh, '-|' ) # forking open
        {
        $sel->add( $fh ); # parent
        $fh2id{$fh} = $id;
        }
      else # child code goes here
        {
        print freeze $childcallback->($id);
        exit;
        }
      }
    for my $fh ( $sel->can_read ) # collecting child data
      {
      $sel->remove( $fh );
      $resultcallback->($fh2id{$fh}, thaw do { local $/; <$fh> });
      }
    }
  }

1;

__END__

=head1 EXAMPLE program
  
 use Forking::Amazing;               # small example program
 use Data::Dump 'dd';
 Forking::Amazing::run(
   5,                                # max forks
   sub { +{id => pop, pid => $$} },  # runs in child
   sub {dd pop},                     # process result of child in parent
   'a'..'z');                        # ids (one fork for each id)

=cut

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;;
use Forking::Amazing;
use Data::Dump 'dd';
use Time::HiRes qw(time);

my $groupsize = 1000;
my @rawids = 'job0001' .. 'job9999';
my @ids;
push @ids, [ splice @rawids, 0, $groupsize ] while @rawids;

my @answers;
my $start = time;

Forking::Amazing::run
  20,
  sub { [ map +{id => $_, pid => $$, time => time - $start}, @{+shift} ] },
  sub { push @answers, @{+pop} },
  @ids;

my $end = time - $start;
dd \@answers;
print "forking time $end\n";