Perl IPC::Run 输入文件大于 64KiB 的管道块答案

【问题标题】：Perl IPC::Run pipeline blocks with input file larger than 64KiBPerl IPC::Run 输入文件大于 64KiB 的管道块
【发布时间】：2020-07-05 07:53:25
【问题描述】：

Perl 程序使用IPC::Run 将文件通过在运行时确定的一系列命令传递到另一个文件中，就像这个小测试摘录所示：

#!/usr/bin/perl
use IO::File;
use IPC::Run qw(run);

open (my $in, 'test.txt');
my $out = IO::File->new_tmpfile;

my @args = ( [ split / /, shift ], "<", $in); # this code
while ($#ARGV >= 0) {                         # extracted
    push @args, "|", [ split / /, shift ];    # verbatim
}                                             # from the
push @args, ">pipe", $out;                    # program

print "Running...";
run @args or die "command failed ($?)";
print "Done\n";

它从作为参数给出的命令构建管道，测试文件是硬编码的。问题是如果文件大于 64KiB，管道就会挂起。这是一个演示，它在管道中使用cat 以保持简单。首先一个 64KiB（65536 字节）的文件按预期工作：

$ dd if=/dev/urandom of=test.txt bs=1 count=65536
65536 bytes (66 kB, 64 KiB) copied, 0.16437 s, 399 kB/s
$ ./test.pl cat
Running...Done

接下来，再增加一个字节。对run 的调用永远不会返回...

$ dd if=/dev/urandom of=test.txt bs=1 count=65537
65537 bytes (66 kB, 64 KiB) copied, 0.151517 s, 433 kB/s
$ ./test.pl cat
Running...

启用IPCRUNDEBUG，再加上几只猫，您可以看到它是最后一个没有结束的孩子：

$ IPCRUNDEBUG=basic ./test.pl cat cat cat cat
Running...
...
IPC::Run 0000 [#1(3543608)]: kid 1 (3543609) exited
IPC::Run 0000 [#1(3543608)]: 3543609 returned 0
IPC::Run 0000 [#1(3543608)]: kid 2 (3543610) exited
IPC::Run 0000 [#1(3543608)]: 3543610 returned 0
IPC::Run 0000 [#1(3543608)]: kid 3 (3543611) exited
IPC::Run 0000 [#1(3543608)]: 3543611 returned 0

（对于 64KiB 以下的文件，您会看到所有四个都正常退出）

如何使它适用于任何大小的文件？

（Perl 5，版本 30，subversion 3 (v5.30.3) 为 x86_64-linux-thread-multi 构建，在目标平台 Alpine Linux 和 Arch Linux 上尝试排除 Alpine 的原因）

【问题讨论】：

另见Deadlocks due to buffering. How does it work?
提示：将use IO::File; my $out = IO::File->new_tmpfile;（创建文件）替换为use Symbol qw( gensym ); my $out = gensym;（创建匿名glob）。创建文件后立即关闭它是没有意义的！
@ikegami 实际程序中的文件没有关闭，但程序继续使用它。以上是一个最小的例子。还有 Håkon Hægland 我读过有关管道缓冲的文章，但我不明白当管道清空到文件中时它是如何应用的？
@starfry，用管道替换文件时被run关闭。
Re “当管道清空到文件中时？”，管道不会清空任何内容。通过从管道中读取进程来读取/清空管道。

标签： perl ipc perl-ipc-run

【解决方案1】：

你有一个死锁：

考虑改用以下方法之一：

run [ 'cat' ], '<', $in_fh, '>', \my $captured;

# Do something with the captured output in $captured.

或

my $receiver = sub {
    # Do something with the chunk in $_[0].
};

run [ 'cat' ], '<', $in_fh, '>', $receiver;

例如，以下“接收器”会在每一行进入时对其进行处理：

my $buffer = '';
my $receiver = sub {
    $buffer .= $_[0];
    while ($buffer =~ s/^(.*)\n//) {
       process_line("$1");
    }
};

run [ 'cat' ], '<', $in_fh, '>', $receiver;

die("Received partial line") if length($buffer);

【讨论】：

谢谢。作为IPC::run 的第一个用户，我从reading about it 认为我可以只使用文件句柄作为输出，并假设这意味着run 将传递到文件并处理任何阻塞。当它与小测试一起工作时，它会陷入一种虚假的幸福状态。我使用了你建议的子程序方法，我的程序现在可以正常工作了。
哦，它绝对可以毫无问题地将输出发送到文件句柄或文件（例如，通过使用'>', $file_handle 或'>', $qualified_file_name），但是您要求它创建一个可以从中读取的管道并将输出发送到该管道。它显然不会从那个管道中读取，因为这会违背请求管道的目的！
@ikegami 我知道如果文件大小超过 64 KiB，>pipe 和 > 之间存在差异。但我不明白为什么 >pipe 不能以相同的方式工作作为>。是不是因为在内存中分配了管道而在磁盘上分配了>？
我来到这里是因为我最初使用> 来处理文件句柄，但它不起作用。我切换到>pipe 并让它工作（受 64K 问题的影响）。我现在再次尝试> 到文件句柄，它可以工作。我不知道为什么以前没有 - 可能是因为我一定犯了一个愚蠢的错误，因为 Perl 不是我常用的。
不，它从未与>pipe 一起使用。您打开的文件中从未写入任何内容。如前所述，文件句柄已根据您的要求替换为管道，在文件被使用之前将其关闭。

【解决方案2】：

这是一个没有死锁但仍使用>pipe 输出句柄的示例。我不建议在您的用例中使用这种复杂的方法，而是考虑@ikegami 建议的方法。

问题是>pipe 句柄永远不会被读取。 cat 尝试写入 >pipe 句柄，但它被填满（因为没有人从中读取），当管道内容达到 64 KiB（Linux 上管道的容量）时，cat 进程阻塞。现在IPC::Run::finish() 进程正在等待子cat 进程退出，但同时cat 进程正在等待父进程从其管道中读取，所以我们遇到了死锁情况。

为了避免这种情况，我们可以用IPC::Run::start()代替IPC::Run::run()：

use feature qw(say);
use strict;
use warnings;
use constant READ_BUF_SIZE => 8192;

use Errno qw( EAGAIN );
use IO::Select;
use IPC::Run qw();
use Symbol 'gensym';

my $outfile = 'out.txt';
open (my $out, '>', $outfile) or die "Could not open file '$outfile': $!";
my $h = IPC::Run::start ['cat'], '<', 'test.txt', '>pipe', my $pipeout = gensym;
my $select = IO::Select->new( $pipeout );
my $data = '';
my $read_offset = 0;
while (1) {
    my @ready = $select->can_read;
    last if !@ready;
    for my $fh (@ready) {
        my $bytes_read = sysread $fh, $data, READ_BUF_SIZE, $read_offset;
        say "Read $bytes_read bytes..";
        if ( !defined $bytes_read ) {
            die "sysread failed: $!" if $! != EAGAIN;
            $bytes_read = 0;
        }
        elsif ( $bytes_read == 0 ) {
            say "Removing pipe handle from select loop";
            $select->remove( $fh );
            close $fh;
        }
        $read_offset += $bytes_read;
    }
}
say "Saving data to file..";
print $out $data;  #Save data to file
close $out;
say "Finishing harness..";
IPC::Run::finish $h or die "cat returned $?";
say "Done.";

【讨论】：