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

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

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

我使用的是 Windows 10.0.18362 build 18362。我使用的是为 MSWin32-x86-multi-thread 构建的 ActiveState perl 5,version 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 中完全不习惯（这不是我第一次陷入那个陷阱），无论如何，我愿意在上述限制范围内进行更正。

解决方法

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

尝试使用 select(2) (https://perldoc.perl.org/functions/select#select-RBITS,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 可能要简单得多