#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11107627
use warnings;
use IO::Socket;
use Forking::Amazing;

my $maxforks = 10;                 # tune these ...
my $forks = my $minforks = 2;
my $clientsperchild = 1000;
my $lifetime = 10;
my $port = 6666;

my $listen = IO::Socket::INET->new(LocalPort => $port,
  Listen => 20, Reuse => 1) or die "$@ on listen create";

Forking::Amazing::run
  $maxforks,
  sub
    {
    print "child $$\n";
    my $idle = 0;
    $SIG{ALRM} = sub { $idle = 1 };
    alarm $lifetime;
    for (1 .. $clientsperchild)
      {
      process( scalar $listen->accept or return [ 1 ] );
      $idle and return [ 1 ]; # idle
      alarm $lifetime;                                    # reset timeout
      }
    return [ 0 ]; # not idle
    },
  sub
    {
    my $idle = pop()->[0];
    if( $idle and $forks > $minforks )
      {
      $forks--;
      print "forks: $forks\n";
      }
    elsif( ! $idle and $forks < $maxforks )
      {
      push @Forking::Amazing::ids, 1, 1;
      $forks++;
      print "forks: $forks\n";
      }
    else
      {
      push @Forking::Amazing::ids, 1;
      }
    },
  (1) x $minforks;

sub process                                         # custom code  goes in here
  {
  my $socket = shift;
  my $query = <$socket>;                                # read query
# select undef, undef, undef, 0.001;
  print $socket "prefork $$ is answering: $query";    # reply
  }