使用Perl解析stdout时避免缓冲

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 "Debugn";
        }
        close(README);
    }
);
while(1) {
    # evaluate variable each ~second
    print "$varn";
    sleep 1;
}

对于某些命令来说，这可以很好地工作，并且行会在输入时进行处理。输出类似于：

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

然而，对于其他命令，这种行为很奇怪，并且行是按块处理的。因此$var在一段时间内不会更新，Debug也不会打印。然后，突然输出是（类似于）：

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

并且CCD_ 3被设置为最后/当前值。然后这种情况重复出现。解析总是被延迟并在块中完成，而$var在其间不被更新。

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

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

我读过，使用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 "$varn";
    sleep 1;
}
sub exit_safely {
    my ($sig) = @_;
    print "Caught SIG $sign";
    # harness has to be killed, otherwise
    # it will continue to run in background
    $h->kill_kill;
    $thr->join();
    exit(0);
}
exit(0);