在Perl中,我如何验证Parallel :: ForkManager的每个子节点都完成它的工作?

时间:2013-08-06 23:51:39

标签: perl error-handling

我正在使用Net::FTPParallel::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中杀死我的子进程。这使我很难确保每个孩子都跑完成或再试一次,直到成功为止。

我尝试做的是,如果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;语法是否正确,或者是否存在我遗漏的问题?它似乎运作良好,但感觉不稳定,我想知道是否有一个更成熟的模式来解决确保每个子进程在工作完成之前存活的问题。

欢迎任何建议。谢谢!

1 个答案:

答案 0 :(得分:4)

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";
      }
   }
);