Как я могу управлять пулом вилок в Perl? - PullRequest
6 голосов
/ 24 марта 2010

Я настраиваю что-то для SSH на несколько серверов в пакетном режиме. В основном я хочу поддерживать 5 соединений одновременно, и когда одно из них заканчивается, открываем другое (после массива IP-адресов серверов).

Мне интересно, что-то вроде этого следует использовать fork () ? Если да, то какую логику я могу использовать, чтобы обеспечить одновременное содержание 5 детей?

Ответы [ 4 ]

11 голосов
/ 24 марта 2010

Форкинг (или многопоточность) - это то, что вам нужно, но вы должны посмотреть на 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
}
5 голосов
/ 24 марта 2010

Есть несколько модулей, которые решают именно эту проблему.См. Parallel :: ForkManager , Forks :: Super или Proc :: Queue , например.

1 голос
/ 29 марта 2011
use Net::OpenSSH::Parallel;

my $pssh = Net::OpenSSH::Parallel->new(connections => 5);

for my $ip (@ips) {
  $pssh->add_host($ip);
}

$pssh->push('*', command => 'do this');
$pssh->push('*', command => 'do that');
$pssh->push('*', scp_get => 'foo', 'bar-%HOST%');
$pssh->push('*', scp_put => 'doz', 'there');

$pssh->run;
0 голосов
/ 25 марта 2010

Мой личный фаворит (!) Фаворит 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 /

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...