Perl process queue

Question

I have a Perl script that creates several subprocesses. I would like to have functionality such as xargs --max-procs=4 --max-args=1or make -j 4where Perl will support a certain number of processes until they end.

It’s easy to say that fork has four processes and is waiting for them to finish, and then scroll through four more, but I would like four or more processes to be executed simultaneously, deploying a new process as soon as you finish.

Is there an easy way in Perl to implement such a process pool?

Answer 1

Forks::Super can handle this requirement.

use Forks::Super MAX_PROC => 5, ON_BUSY => [ block | queue ];

fork() , 5, fork, :

fork { sub => sub { ... task to run in subprocess ... } }

, .

( ).

Answer 2

Parallel::ForkManager - , . , , ( ).

Answer 3

CPAN - AnyEvent, , , . , , perl. C .

#!/usr/bin/env perl

use strict;

## run a function in a forked process
sub background (&) {
  my $code = shift;

  my $pid = fork;
  if ($pid) {
    return $pid;
  } elsif ($pid == 0) {
    $code->();
    exit;
  } else{
    die "cant fork: $!"
  }
}

my @work = ('sleep 30') x 8;
my %pids = ();
for (1..4) {
  my $w = shift @work;
  my $pid = background {
    exec $w;
  };
  $pids{$pid} = $w; 
}

while (my $pid = waitpid(-1,0)) {
  if ($?) {
    if ($? & 127) {
      warn "child died with signal " . ($? & 127);
    } else {
      warn "chiled exited with value " . ($? >> 8);
    }

    ## redo work that died or got killed
    my $npid = background {
      exec $pids{$pid};
    };
    $pids{$npid} = delete $pids{$pid};
  } else {
    delete $pids{$pid};

    ## send more work if there is any
    if (my $w = shift @work) {
      my $pid = background {
        exec shift @work;
      };
      $pids{$pid} = $w;
    }
  }
}