perl - 在 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
}

让所有子进程迅速完成(关闭它们的标准输入)的一种方法是让我的脚本退出而不关闭(管道)文件句柄，但这不好，因为脚本是需要子进程的更大工作的一部分”在继续之前实际完成的工作。

关闭每个子进程的标准输入(以便它们都可以完成工作)然后等待所有子进程完成后再继续的简单方法是什么？我试过 fork 一个 child 来关闭每个管道，但这似乎不起作用——只有 parent 的“关闭”实际上关闭了子进程的标准输入并等待子进程完成。

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()不是在等待 child 退出:

# 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--;
  }
}