perl coda processo

Question

Ho uno script Perl che si biforca una serie di sotto-processi. Mi piacerebbe avere un qualche tipo di funzionalità come xargs --max-procs=4 --max-args=1 o make -j 4, in cui Perl manterrà un determinato numero di processi in esecuzione fino a quando non avrà finito il lavoro.

È facile dire il processo di fork four e attendere che tutti vengano completati, quindi biforcare altri quattro, ma vorrei mantenere in esecuzione contemporaneamente quattro o n processi, creando un nuovo processo non appena uno completa.

C'è un modo semplice in Perl per attuare tale pool di processi?

Answer 1

Forks::Super in grado di gestire questo requisito.

chiamate verso fork() in grado di bloccare fino a quando il numero di sottoprocessi attivi scende al di sotto 5, oppure si può passare parametri aggiuntivi al fork chiamata e le attività da svolgere può coda:

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

Quando uno Sottoprocesso finisce, verrà avviato un altro lavoro in coda.

(sono l'autore di questo modulo).

Answer 2

Check out Parallel::ForkManager - fa molto di ciò che descrivi. È possibile impostare un numero massimo di processi e la funzione di callback potrebbe avviare un nuovo figlio non appena ne termina uno (purché ci sia lavoro da fare).

Answer 3

Mentre usavo quasi sempre un modulo CPAN, o scrivevo qualcosa con i fantastici moduli AnyEvent, penso che sia importante capire come funzionano queste cose sotto il cofano. Ecco un esempio che non ha dipendenze diverse da Perl. Lo stesso approccio potrebbe anche essere scritto in C senza troppi problemi.

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