Как я могу управлять пулом ветвления в Perl?
Я устанавливаю что-то до SSH к нескольким серверам в 'пакетах'. Я в основном хочу поддержать 5 соединений за один раз, и когда каждый заканчивает, открывают другого (после массива дюйм/с сервера).
Я задаюсь вопросом для чего-то вроде этого, что я должен использовать ветвление ()? Если так, какую логику я могу использовать, чтобы гарантировать, чтобы я поддержал 5 детей за один раз?
3 ответа
Разветвление (или многопоточность) - это то, что вы хотите, но вы должны посмотреть на CPAN для модулей, которые предоставят вам большую часть того, что вам нужно, чтобы вы не изобретали колесо и не мучились с трудностями в обучении тому, что вам нужно делать.
Например, Parallel :: ForkManager выглядит как ТОЧНО то, что вам нужно.
use Parallel::ForkManager;
$pm = new Parallel::ForkManager($MAX_PROCESSES);
foreach $data (@all_data) {
# Forks and returns the pid for the child:
my $pid = $pm->start and next;
... do some work with $data in the child process ...
$pm->finish; # Terminates the child process
}
Мой личный форк (!) Фаворит - Proc :: Fork
Общий обзор из модуля:
use Proc::Fork;
run_fork {
child {
# child code goes here.
}
parent {
my $child_pid = shift;
# parent code goes here.
waitpid $child_pid, 0;
}
retry {
my $attempts = shift;
# what to do if if fork() fails:
# return true to try again, false to abort
return if $attempts > 5;
sleep 1, return 1;
}
error {
# Error-handling code goes here
# (fork() failed and the retry block returned false)
}
};
И чтобы ограничить максимальное количество процессов, запущенных для чего-то вроде пакетов SSH, это должно помочь:
use strict;
use warnings;
use 5.010;
use POSIX qw(:sys_wait_h);
use Proc::Fork;
my $max = 5;
my %pids;
my @ssh_files = (
sub { system "scp file0001 baz@foo:/somedir/." },
...
sub { system "scp file9999 baz@foo:/somedir/." },
);
while (my $proc = shift @ssh_files) {
# max limit reached
while ($max == keys %pids) {
# loop thru pid list until a child is released
for my $pid (keys %procs) {
if (my $kid = waitpid($pid, WNOHANG)) {
delete $pids{ $kid };
last;
}
}
}
run_fork {
parent {
my $child = shift;
$pids{ $child } = 1;
}
child {
$proc->();
exit;
}
}
}
/ I3az /
Есть несколько модулей, которые решают именно эту проблему. См., Например, Parallel :: ForkManager , Forks :: Super или Proc :: Queue .