#!/usr/bin/perl

# https://perlmonks.org/?node_id=11105742

use strict;
use warnings;
use Forking::Amazing;

my @data = ( 10,4,20,2,15,6 );

Forking::Amazing::run
  2,
  sub # in child
    {
    my ($slotnow, $n) = @{ shift() };
    print "started $slotnow  sleep($n)\n";
    [ sleep $n ];
    },
  sub # in parent
    {
    my ($slotnow, $n) = @{ shift() };
    print "  ended $slotnow - $n\n";
    @data and push @Forking::Amazing::ids, [ $slotnow, shift @data ];
    },
  map [ $_, shift @data ], qw( one two );

##</code><code>##

started one  sleep(10)
started two  sleep(4)
  ended two - 4
started two  sleep(20)
  ended one - 10
started one  sleep(2)
  ended one - 2
started one  sleep(15)
  ended two - 20
started two  sleep(6)
  ended one - 15
  ended two - 6

##</code><code>##

package Forking::Amazing;

use strict;
use warnings;

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

  use Storable qw( freeze thaw );
  use IO::Select;
  my @fh2id;
  my $sel = IO::Select->new;
  while( @ids or $sel->count ) # unstarted or active
    {
    for my $id ( splice @ids, 0, $maxforks - $sel->count ) # allowed forks
      {
      if( my $pid = open my $fh, '-|' ) # forking open
        {
        $sel->add( $fh ); # parent
        $fh2id[$fh->fileno] = $id;
        }
      elsif( defined $pid ) # child
        {
        print freeze
          do {local *STDOUT; open STDOUT, '>&STDERR'; $childcallback->($id) };
        exit;
        }
      else
        {
        $resultcallback->( $id, $childcallback->($id) );
        }
      }
    for my $fh ( $sel->can_read ) # collecting child data
      {
      $sel->remove( $fh );
      $resultcallback->($fh2id[$fh->fileno], thaw do { local $/; <$fh> });
      }
    }
  }

1;

__END__

=head1 NAME

Forking::Amazing - a fork manager

=head1 SYNOPSIS

 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},                     # act on result of child in parent
   'a'..'z');                        # ids (one fork for each id)

=head1 DESCRIPTION

A simple fork manager that runs a limited number of forks at a time,
It does callbacks for the code to be run in the children,
and the code to be run in the parent when a child exits and returns a value.

=head1 CALLING SEQUENCE

Forking::Amazing::run( $maxforks, \&childcallback, \&returncallback, @ids);

The childcallback runs in a child.

The childcallback gets an id as argument, and must return a value
that can be processed by Storable::freeze (basically a ref).
In the childcallback, STDOUT is redirected to STDERR,

The resultcallback runs in the parent.

The resultcallback get two arguments, an id and the value returned
by a childcallback.

@ids can be any scalar including numbers, strings, or refs.
@ids can be used to pass starting parameters to a child, for
example, to pass two parameters to a child use [ $param1, $param2 ] as an id.

Additional ids can be added by pushing them to @Forking::Amazing::ids

=head1 RETURN VALUE

Forking::Amazing::run returns after all forked children have finished.
There is no return value.

=cut