perl - 在Perl中，如何验证Parallel::ForkManager finishes its job?的每个 child

Question

我正在开发一个使用Net::FTP和Parallel::ForkManager的Perl程序。在使用ForkManager创建的每个子进程中，我正在调用许多Net::FTP方法。不幸的是，由于连接问题，这些偶尔会失败。

在Net::FTP文档中，他们明确指出您可以/应该处理失败的方法调用，如下所示:

$ftp = Net::FTP->new("some.host.name", Debug => 0) or die "Cannot connect to some.host.name: $@";

这样可以很好地检测错误，但是会在ForkManager中杀死我的子进程。这使我很难确保每个 child 都跑到完成状态或再次尝试直到成功为止。

我想做的是，如果Net::FTP方法失败，则从子例程中发出警告(与上面的消逝消息类似的消息)和 return 0。我的想法是，这将使我能够重新连接到FTP并重试，而不会杀死我的子进程。像这样(这只是一个代码片段):

foreach my $page (sort (keys %pages)) {
    my $pid = $pm1->start($page) and next;
    my $ok;
    my $attempts = 1;
    while (!($ok)) {
        print "Attempts on $page: $attempts\n";
        $ok = ftp_server_process($page);
        $attempts++;
    }
    $pm1->finish;
}

使用相关的子例程:

sub ftp_server_process {
    my $ftp = Net::FTP->new("some.ip", Debug => 0, Passive => 1, BlockSize => 1048576) or warn "Cannot connect to some.ip for page $page: $@" and return 0;
    $ftp->login("username", "password") or warn "Cannot login to some.ip\n", $ftp->message and return 0;
    $ftp->binary or warn "opening binary mode failed\n", $ftp->message and return 0;
    $ftp->cwd($ftp_input_folder) or warn "changing directory failed\n", $ftp->message and return 0;
    $ftp->put($pages{$page}{"ftp_upload_name"}) or warn "putting page $page failed\n", $ftp->message and return 0;
    $ftp->quit;
    return 1;
}

这是解决这个问题的合理方法吗？ object->method or warn "a message" and return 0;语法是否正确，还是我遗漏了一个问题？它似乎运行良好，但感觉不稳，我想知道是否存在更完善的模式来解决确保每个子进程都能生存直到完成工作的问题。

欢迎任何建议。谢谢!

Answer 1

die和捕获异常更加简单。

for my $page (sort keys %pages) {
    $pm->start($page) and next;

    my $attempts_left = 3;
    LOOP: {
        if (!eval { ftp_server_process($page); 1 }) {
           warn $@;
           if (--$attempts_left) {
              warn "Retrying...\n";
              redo;
           } else {
              warn "Aborting.\n";
              $pm->finish(1);
           }
        }
    }

    $pm->finish(0);
}

如果您愿意，您甚至可以记录父进程中哪个失败:

$pm->run_on_finish(sub {
   my ($pid, $exit_code, $page, $signal) = @_;
   if ($exit_code || $signal) {
      print "Couldn't put page $page: ";
      if ($exit_code) {
         print "Exited with $exit_code\n";
      } else {
         print "Killed by signal $signal\n";
      }
   }
);