perl cola de proceso

Question

Tengo un script Perl que divide varios subprocesos. Me gustaría tener algún tipo de funcionalidad como xargs --max-procs=4 --max-args=1 o make -j 4, donde Perl mantendrá un número determinado de procesos en ejecución hasta que se quede sin trabajo.

Es fácil decir el proceso de la horquilla cuatro y esperar a que todos se completen, y luego dividir otros cuatro, pero me gustaría mantener cuatro o n procesos funcionando al mismo tiempo, creando un nuevo proceso tan pronto como uno completa.

¿Existe alguna manera sencilla en Perl para implementar dicho grupo de procesos?

Answer 1

Forks::Super puede manejar este requisito.

llamadas a fork() pueden bloquear hasta que el número de subprocesos activos cae por debajo de 5, o puede pasar parámetros adicionales al fork llamada y las tareas a realizar puede poner en cola:

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

Cuando uno el subproceso termina, se iniciará otro trabajo en la cola.

(soy el autor de este módulo).

Answer 2

Echa un vistazo Parallel::ForkManager - hace mucho de lo que describes. Puede establecer un número máximo de procesos, y la función de devolución de llamada podría iniciar un nuevo hijo tan pronto como termine (siempre que haya trabajo por hacer).

Answer 3

Si bien casi siempre usaría un módulo CPAN, o escribiría algo con los fantásticos módulos AnyEvent, creo que es importante entender cómo funcionan estas cosas bajo el capó. Aquí hay un ejemplo que no tiene dependencias aparte de perl. El mismo enfoque también podría escribirse en C sin demasiados problemas.

#!/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; 
    } 
    } 
}