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

Question

一个 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";

它根据作为参数给出的命令构建管道，测试文件是 hard-coded。问题是如果文件大于 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 的调用从不 returns...

$ 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 后，再加上几只猫，您可以看到它是最后一个 child 没有结束的：

$ 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 以下的文件，您会看到所有四个都正常退出）

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

（为 x86_64-linux-thread-multi 构建的 Perl 5，版本 30，颠覆 3（v5.30.3），在 Alpine Linux，目标平台和 Arch Linux 排除阿尔卑斯山的原因）

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

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

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

Answer 2

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

问题是 >pipe 句柄从未被读取。 cat 尝试写入 >pipe 句柄但它被填满（因为没有人从中读取）并且当管道内容达到 64 KiB 时 cat 进程阻塞，这是容量Linux 上的管道。现在 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.";

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

Perl IPC::Run pipeline blocks with input file larger than 64KiB

perl

ipc

perl-ipc-run