perl process queue

Question

Ich habe ein Perl-Skript, das eine Reihe von Unterprozessen ausgibt. Ich hätte gerne irgendeine Art von Funktionalität wie xargs --max-procs=4 --max-args=1 oder make -j 4, wo Perl eine bestimmte Anzahl von Prozessen laufen lässt, bis es keine Arbeit mehr hat.

Es ist einfach zu sagen, vier fork-Prozess und warten auf sie alle zu vervollständigen, und dann vier weitere, aber ich möchte vier oder n Prozesse zur gleichen Zeit ausgeführt werden, Forking einen neuen Prozess sobald einer schließt ab.

Gibt es in Perl einen einfachen Weg, einen solchen Prozesspool zu implementieren?

Answer 1

Forks::Super kann diese Anforderung erfüllen.

Anrufe an fork() können blockieren, bis die Zahl der aktiven Unterprozesse unter 5 fällt, oder Sie können zusätzliche Parameter zum fork Aufruf übergeben, und die Aufgaben anstehen kann:

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

Wenn man der Subprozess endet, ein anderer Job in der Warteschlange wird gestartet.

(Ich bin der Autor dieses Moduls).

Answer 2

Check out Parallel::ForkManager - es tut viel von dem, was Sie beschreiben. Sie können eine maximale Anzahl von Prozessen festlegen, und die Callback-Funktion kann ein neues Kind starten, sobald Sie fertig sind (solange noch etwas zu tun ist).

Answer 3

Während ich fast immer ein CPAN-Modul verwenden oder etwas mit den fantastischen AnyEvent-Modulen schreiben würde, ist es meiner Meinung nach wichtig zu verstehen, wie diese Dinge unter der Haube funktionieren. Hier ist ein Beispiel, das keine anderen Abhängigkeiten als Perl hat. Derselbe Ansatz könnte auch ohne große Probleme in C geschrieben werden.

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