在perl中关闭多个输出管道而不会阻塞每个输出管道

Question

我有一个perl脚本,它将大量输出发送到多个子进程.我需要能够关闭所有管道的末端,然后等待子流程完成他们的工作.到目前为止,我只是成功地关闭了每个管道并等待每个子进程逐个完成.更具体地说,我正在做这样的事情:

for ($i=0;$i<24;$i++) {
    my $fh;
    open $fh, "|externalprogram $i";
    $fhs{$i}=$fh;
}

#...now I can write output to the pipes
while (moreworktodo()) {
    $whichone, $data = do_some_work();
    print $fhs{$whichone} $data;
}
#Now I just need to wait for all the subprocesses to finish.  However, they
#need to do a lot of work that can only begin when they've finished reading input.  So I need to close my end of the pipe to indicate I'm finished.
for ($i=0;$i<24;$i++) {
    my $file = $fhs{$i};
    close $file;  #unfortunately, this blocks until process $i finishes
    #meanwhile all the other processes are waiting for EOF 
    #on their STDIN before they can proceed.  So I end up waiting
    #for 24 processes to finish one-at-a-time instead of all at once
}

让所有子进程快速完成(关闭stdin)的一种方法就是让我的脚本退出而不关闭(管道)文件句柄,但这并不好,因为脚本是需要子进程的大型作业的一部分'在继续之前要完成工作.

什么是关闭每个子进程的标准输入的简单方法(以便它们都可以完成工作),然后等待所有子进程完成后再继续？我试图让一个孩子关闭每个管道,但这似乎不起作用 - 只有父的"关闭"实际上关闭了子进程的stdin并等待子进程完成.

Answer 1

我会自己创建管道而不是使用open(P, "|external-program").然后,您可以关闭管道,而不是等待子进程退出.

自己打开管道到子进程的示例:

sub spawn {
  my ($cmd) = @_;

  pipe(my $rp, $wp) or die "pipe failed: $!";

  my $pid = fork();
  die "fork: $!" unless defined($pid);
  if ($pid) {
    # parent
    close($rp);
    return ($wp, $pid);
  } else {
    # child
    close($wp);
    open(STDIN, "<&", $rp);
    exec($cmd) or die "exec: $!";
  }
}

sub main {
  $| = 1;
  my ($wp, $pid) = spawn("./child");
  for (1..10) {
    print {$wp} "sending $_\n";
  }
  close($wp);
  print "done\n";
 }

 main();

这是一个测试的子程序示例,close()它不等待孩子退出:

# file: ./child
while (<STDIN>) {
  print "got: $_";
  sleep(2);
}

最后一个难题是异步等待子进程退出.这可以通过$SIG{CHLD}处理程序完成,或者,这里是一个简单的"join_children"函数:

my @child_ids = (1..24); # or whatever ids you want to use
my %pipe;                # hash map from child_id -> pipe handle

sub join_children {
  for my $id (@child_ids) {
    close( $pipe{$id} );
  }

  my $count = scalar(@child_ids);
  while ($count > 0) {
    wait;
    $count--;
  }
}