在Perl中，如何驗證Parallel :: ForkManager的每個孩子完成其作業？

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我的子進程。這使我很難確保每個孩子都跑完成或再次嘗試，直到成功。

我想要做的是，如果一個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"; 
     } 
    } 
);