kolejka procesów perla

Question

Mam skrypt Perla, który wyświetla wiele podprocesów. Chciałbym mieć jakąś funkcjonalność, taką jak xargs --max-procs=4 --max-args=1 lub make -j 4, gdzie Perl będzie utrzymywał określoną liczbę uruchomionych procesów, dopóki nie skończy się praca.

Łatwo jest powiedzieć, że proces "widelec czwarty" i czekać, aż wszystkie się zakończą, a następnie rozwidlić kolejne cztery, ale chciałbym, aby cztery lub kilka procesów przebiegało w tym samym czasie, rozwidlając nowy proces, gdy tylko kończy.

Czy w Perlu istnieje prosty sposób wdrożenia takiej puli procesów?

Answer 1

Forks::Super może obsłużyć to wymaganie.

apeluje do fork() może blokować aż liczba aktywnych podprocesów spadnie poniżej 5, albo można przekazać dodatkowe parametry do połączenia fork i zadań do wykonania może kolejce:

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

Kiedy jeden zakończenie podprocesu rozpocznie się inne zadanie w kolejce.

(Jestem autorem tego modułu).

Answer 2

Zapoznaj się z Parallel::ForkManager - robi wiele z tego, co opisujesz. Możesz ustawić maksymalną liczbę procesów, a funkcja wywołania zwrotnego może uruchomić nowe dziecko, gdy tylko się zakończy (tak długo, jak będzie to wymagało pracy).

Answer 3

Chociaż prawie zawsze korzystam z modułu CPAN lub piszę coś z fantastycznymi modułami AnyEvent, uważam, że ważne jest zrozumienie, jak te rzeczy działają pod maską. Oto przykład, który nie ma zależności innych niż perl. To samo podejście można również napisać w C bez większych problemów.

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