1

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 的原因）

4

2 回答 2

2

你有一个僵局：

死锁示意图

考虑改用以下方法之一：

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);
于 2020-07-05T10:01:43.087 回答
0

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

问题是>pipe句柄永远不会被读取。cat尝试写入>pipe句柄但它被填满（因为没有人从中读取）并且cat当管道内容达到 64 KiB 时进程阻塞，这是 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.";
于 2020-07-05T21:06:07.210 回答