无法使用管道在 Windows 上的 Perl 中捕获 stdout/stderr

Question

我正在尝试编写一个生成子进程的函数，允许我们分别捕获标准输出和标准错误，并返回它的退出状态。我知道有这方面的库，但是让我们限制不使用第三方库，只使用内置函数和语言特性（在更大的问题范围内，我无法控制这些限制，抱歉）。

我使用的是 Windows 10.0.18362 build 18362。我使用的是为 MSWin32-x86-multi-thread 构建的 ActiveState perl 5，版本 28，subversion 1 (v5.28.1)。

这是一个最小的复制：

foo.pl

use strict;
use Data::Dumper;

sub _autoflush {
    my ($fh, $val) = @_;
    my $prev = select $fh;
    $| = $val;
    select $prev;
}

sub _create_pipe {
    my ($overload_fh) = @_;
    my $fd = fileno($overload_fh);
    open(my $orig, ">&", $overload_fh) || die("failed to save fd $fd");
    pipe(my $rh, my $wh);
    _autoflush($rh, 1);
    _autoflush($wh, 1);
    open($overload_fh, ">&", $wh) || die("failed to dup fd $fd");
    close($wh);
    return ($rh, $orig);
}

sub _restore_handle {
    my ($overload_fh, $orig) = @_;
    my $fd = fileno($orig);
    open($overload_fh, ">&", $orig) || die("failed to restore fd $fd");
}

sub _capture_stream {
    my ($read_handle) = @_;
    my $cap;
    while (<$read_handle>) {
        s/\r\n/\n/g;
        $cap .= $_;
    }
    return $cap;
}

sub subprocess_run {
    my ($cmd) = @_;
    my ($rh1, $orig1) = _create_pipe(\*STDOUT);
    my ($rh2, $orig2) = _create_pipe(\*STDERR);

    my $exit_status = system($cmd);
    close(STDOUT);
    close(STDERR);

    my $stdout_capture = _capture_stream($rh1);
    my $stderr_capture = _capture_stream($rh2);

    _restore_handle(\*STDOUT, $orig1);
    _restore_handle(\*STDERR, $orig2);
    
    return ($stdout_capture, $stderr_capture, $exit_status);
}

my ($stdout, $stderr, $exit_status) = subprocess_run(qq(cmd /c "perl bar.pl"));
my @stdout = split /\n/, $stdout;
my @stderr = split /\n/, $stderr;
print(Dumper(\@stdout));
print(Dumper(\@stderr));
print(Dumper($exit_status >> 8));

bar.pl:

use strict;

for (1..125) {
    print "$_\n";
}
exit 1;

上述死锁，但如果我将范围从 1..125 更改为 1..124 它可以工作。我使用1..124 得到的输出是预期的输出：

$VAR1 = [
          '1',
          '2',
          '3',
          '4',
          '5',
          '6',
          '7',
          '8',
          '9',
          '10',
          '11',
          '12',
          '13',
          '14',
          '15',
          '16',
          '17',
          '18',
          '19',
          '20',
          '21',
          '22',
          '23',
          '24',
          '25',
          '26',
          '27',
          '28',
          '29',
          '30',
          '31',
          '32',
          '33',
          '34',
          '35',
          '36',
          '37',
          '38',
          '39',
          '40',
          '41',
          '42',
          '43',
          '44',
          '45',
          '46',
          '47',
          '48',
          '49',
          '50',
          '51',
          '52',
          '53',
          '54',
          '55',
          '56',
          '57',
          '58',
          '59',
          '60',
          '61',
          '62',
          '63',
          '64',
          '65',
          '66',
          '67',
          '68',
          '69',
          '70',
          '71',
          '72',
          '73',
          '74',
          '75',
          '76',
          '77',
          '78',
          '79',
          '80',
          '81',
          '82',
          '83',
          '84',
          '85',
          '86',
          '87',
          '88',
          '89',
          '90',
          '91',
          '92',
          '93',
          '94',
          '95',
          '96',
          '97',
          '98',
          '99',
          '100',
          '101',
          '102',
          '103',
          '104',
          '105',
          '106',
          '107',
          '108',
          '109',
          '110',
          '111',
          '112',
          '113',
          '114',
          '115',
          '116',
          '117',
          '118',
          '119',
          '120',
          '121',
          '122',
          '123',
          '124'
        ];
$VAR1 = [];
$VAR1 = 1;

我认为即使为文件句柄启用了自动刷新，管道也没有被刷新。

我查看了 Capture::Tiny 以了解他们是如何做到的，看起来他们写入临时文件，然后将其读回父进程内存。

关于如何让代码在 Windows 上使用1..125 的范围，而不使用第三方库，同时使用管道，避免磁盘 I/O，有什么想法吗？或者也许这一切在 perl 中都不是惯用的（这不是我第一次陷入这个陷阱），无论哪种方式，我都愿意在上述限制范围内进行更正。

Answer 1

管道的大小有限，如果写入缓冲区写端的数据太大，就会发生死锁。

尝试使用select(2) (https://perldoc.perl.org/functions/select#select-RBITS,WBITS,EBITS,TIMEOUT) 进行轮询实现：

use strict;

sub main {
   vec(my $rin, fileno(STDIN),  1) = 1;
   my $nfound = select(my $rout = $rin, undef, my $eout = $rin, undef);
   print("nfound: $nfound\n");
   print("$!\n");
}

main();

结果

nfound: -1
An operation was attempted on something that is not a socket.

只使用文件 I/O 可能要简单得多