使用 Perl 解析标准输出时避免缓冲

Question

我想使用 Perl 逐行解析外部程序（一些 shell 命令）的输出。该命令连续运行，因此我将其放入一个线程并使用共享变量与我的主程序进行通信。

到目前为止，我的代码看起来类似于

#!/usr/bin/perl

use warnings;
use strict;
use threads;
use threads::shared;

my $var :shared; $var="";

threads->create(
    sub {
        # command writes to stdout each ~100ms
        my $cmd = "<long running command> |";
        open(README, $cmd) or die "Can't run program: $!\n";
        while(<README>) {
            my $line = $_;
            # extract some information from line
            $var = <some value>;
            print "Debug\n";
        }
        close(README);
    }
);

while(1) {
    # evaluate variable each ~second
    print "$var\n";
    sleep 1;
}

对于某些命令，这工作得非常好，并且行在它们进入时就被处理。输出类似于：

...
Debug
Debug
...
<value 1>
...
Debug
Debug
...
<value 2>
...

但是，对于其他命令，这表现得很奇怪，并且正在逐块处理这些行。所以$var 没有得到更新，Debug 也有一段时间没有打印出来。然后，突然输出是（类似于）：

...
<value 1>
<value 1>
<value 1>
...
Debug
Debug
Debug
...
<value 20>

并且$var 设置为最后/当前值。然后重复。解析总是延迟并分块完成，而 $var 之间不会更新。

首先：除了使用管道之外，还有什么更好/更合适的方法来解析外部程序的输出（逐行！）？

如果没有，我该如何避免这种行为？

我读过，使用autoflush(1); 或$|=1; 可能是一种解决方案，但仅适用于“当前选择的输出通道”。我将如何在我的上下文中使用它？

提前谢谢你。

Answer 1

在一般情况下，您的脚本无法更改子进程输出的缓冲。在某些特定情况下，您可以通过使用适当的开关来启动它，但仅此而已。

我建议不要编写自己的代码来执行运行和读取，而是重新编写脚本以使用IPC::Run 模块。它的存在就是为了解决这类问题。文档不是有史以来最好的，但模块本身经过充分测试且可靠。

Answer 2

感谢 ikegami 和 Calle Dybedahl，我为我的问题找到了以下解决方案：

#!/usr/bin/perl

use warnings;
use strict;
use threads;
use threads::shared;
use sigtrap qw(handler exit_safely normal-signals stack-trace error-signals);
use IPC::Run qw(finish pump start);

# define shared variable
my $var :shared; $var="";

# define long running command
my @cmd = ('<long running command>','with','arguments');
my $in = '';
my $out = '';
# start harness
my $h = start \@cmd, '<pty<', \$in, '>pty>', \$out;

# create thread
my $thr = threads->create(
    sub {
        while (1) {
            # pump harness
            $h->pump;
            # extract some information from $out
            $var = <some value>;
            # empty output
            $out = '';
        }
    }
);

while(1) {
    # evaluate variable each ~second
    print "$var\n";
    sleep 1;
}

sub exit_safely {
    my ($sig) = @_;
    print "Caught SIG $sig\n";
    # harness has to be killed, otherwise
    # it will continue to run in background
    $h->kill_kill;
    $thr->join();
    exit(0);
}

exit(0);