Perl：避免从标准输入贪婪阅读？答案

【问题标题】：Perl: avoid greedy reading from stdin?Perl：避免从标准输入贪婪阅读？
【发布时间】：2010-09-13 08:06:59
【问题描述】：

考虑以下 perl 脚本 (read.pl)：

my $line = <STDIN>;
print "Perl read: $line";
print "And here's what cat gets: ", `cat -`;

如果从命令行执行此脚本，它将获取第一行输入，而cat 获取其他所有内容，直到输入结束（按下^D）。

但是，当输入从另一个进程通过管道传输或从文件中读取时，情况就不同了：

$ echo "foo\nbar" | ./read.pl
Perl read: foo
And here's what cat gets:

Perl 似乎很容易在某处缓冲整个输入，使用反引号或系统调用的进程看不到任何输入。

问题是我想对一个混合<STDIN> 并调用其他进程的脚本进行单元测试。最好的方法是什么？我可以在 perl 中关闭输入缓冲吗？或者我可以以“模仿”终端的方式假脱机数据吗？

【问题讨论】：

标签： perl unit-testing stdin buffering

【解决方案1】：

这不是 Perl 问题。这是一个 UNIX/shell 问题。当您在没有管道的情况下运行命令时，您处于行缓冲模式，但是当您使用管道重定向时，您处于块缓冲模式。你可以这样说：

cat /usr/share/dict/words | ./read.pl | head

这个C程序也有同样的问题：

#include <stdio.h>

int main(int argc, char** argv) {
    char line[4096];
    FILE* cat;
    fgets(line, 4096, stdin);
    printf("C got: %s\ncat got:\n", line);
    cat = popen("cat", "r");
    while (fgets(line, 4096, cat)) {
        printf("%s", line);
    }
    pclose(cat);
    return 0;
}

【讨论】：

这真的很有帮助，谢谢。有没有办法告诉 shell（或 IPC::Run、popen 或其他任何东西）它应该使用哪种缓冲模式？
@Jonas Wagner 我玩了一段时间。我找不到解决方案。简短的回答是“不要那样做”。让perl 读取STDIN 的内容并将其传递给程序。
Perl 似乎有 Expect.pm，它使用伪 tty 与进程通信（见下面我的回答）。

【解决方案2】：

我有好消息和坏消息。

好消息是对read.pl 的简单修改允许你给它假输入：

#! /usr/bin/perl

use warnings;
use strict;

binmode STDIN, "unix" or die "$0: binmode: $!";

my $line = <STDIN>;
print "Perl read: $line";
print "And here's what cat gets: ", `cat -`;

示例运行：

$ printf "A\nB\nC\nD\n" | ./read.pl
Perl 读取：A
这就是猫得到的：B
C
D

坏消息是你得到一个单一的切换：如果你尝试重复 read-then-cat，第一个 cat 将饿死所有后续读取。要看到这一点，请考虑

#! /usr/bin/perl

use warnings;
use strict;

binmode STDIN, "unix" or die "$0: binmode: $!";

my $line = <STDIN>;
print "1: Perl read: $line";
print "1: And here's what cat gets: ", `cat -`;
$line = <STDIN>;
$line = "<undefined>\n" unless defined $line;
print "2: Perl read: $line";
print "2: And here's what cat gets: ", `cat -`;

然后是产生的示例运行

$ printf "A\nB\nC\nD\n" | ./read.pl
1：Perl 读取：A
1：这就是猫得到的：B
C
D
2：Perl 读取：
2：这就是猫得到的东西：

【讨论】：

非常感谢，我不知道 binmode。

【解决方案3】：

今天我想我找到了我需要的东西：Perl 有一个名为 Expect 的模块非常适合这种情况：

#!/usr/bin/perl

use strict;
use warnings;

use Expect;

my $exp = Expect->spawn('./read.pl');
$exp->send("First Line\n");
$exp->send("Second Line\n");
$exp->send("Third Line\n");
$exp->soft_close();

像魅力一样工作；）

【讨论】：

【解决方案4】：

这是我发现的一种次优方式：

use IPC::Run;

my $input = "First Line\n";
my $output;
my $process = IPC::Run::start(['./read.pl'], \$input, \$output);
$process->pump() until $output =~ /Perl read:/;
$input .= "Second Line\n";
$process->finish();
print $output;

从某种意义上说，这是次优的，因为在等待更多输入之前需要知道程序将发出的“提示”。

另一个次优解决方案如下：

use IPC::Run;

my $input = "First Line\n";
my $output;
my $process = IPC::Run::start(['./read.pl'], \$input, my $timer = IPC::Run::timer(1));
$process->pump() until $timer->is_expired();
$timer->start(1);
$input .= "Second Line\n";
$process->finish();

它不需要任何提示知识，但速度很慢，因为它至少要等待两秒钟。另外，我不明白为什么需要第二个计时器（否则完成不会返回）。

有人知道更好的解决方案吗？

【讨论】：

【解决方案5】：

最后我得到了以下解决方案。仍然远未达到最佳状态，但它确实有效。即使在the one described by gbacon 这样的情况下。

use Carp qw( confess );
use IPC::Run;
use Scalar::Util;
use Time::HiRes;

# Invokes the given program with the given input and argv, and returns stdout/stderr.
#
# The first argument provided is the input for the program. It is an arrayref
# containing one or more of the following:
# 
# * A scalar is simply passed to the program as stdin
#
# * An arrayref in the form [ "prompt", "input" ] causes the function to wait
#   until the program prints "prompt", then spools "input" to its stdin
#
# * An arrayref in the form [ 0.3, "input" ] waits 0.3 seconds, then spools
#   "input" to the program's stdin
sub capture_with_input {
    my ($program, $inputs, @argv) = @_;
    my ($stdout, $stderr);
    my $stdin = '';

    my $process = IPC::Run::start( [$program, @argv], \$stdin, \$stdout, \$stderr );
    foreach my $input (@$inputs) {
        if (ref($input) eq '') {
            $stdin .= $input;
        }
        elsif (ref($input) eq 'ARRAY') {
            (scalar @$input == 2) or
                confess "Input to capture_with_input must be of the form ['prompt', 'input'] or [timeout, 'input']!";

            my ($prompt_or_timeout, $text) = @$input;
            if (Scalar::Util::looks_like_number($prompt_or_timeout)) {
                my $start_time = [ Time::HiRes::gettimeofday ];
                $process->pump_nb() while (Time::HiRes::tv_interval($start_time) < $prompt_or_timeout);
            }
            else {
                $prompt_or_timeout = quotemeta $prompt_or_timeout;
                $process->pump until $stdout =~ m/$prompt_or_timeout/gc;
            }

            $stdin .= $text;
        }
        else {
            confess "Unknown input type passed to capture_with_input!";
        }
    }
    $process->finish();

    return ($stdout, $stderr);
}

my $input = [
    "First Line\n",
    ["Perl read:", "Second Line\n"],
    [0.5, "Third Line\n"],
];
print "Executing process...\n";
my ($stdout, $stderr) = capture_with_input('./read.pl', $input);
print "done.\n";
print "STDOUT:\n", $stdout;
print "STDERR:\n", $stderr;

使用示例（稍微修改了 read.pl 来测试 gbacon 的情况）：

$ time ./spool_read4.pl
Executing process...
done.
STDOUT:
Perl read: First Line
And here's what head -n1 gets: Second Line
Perl read again: Third Line

STDERR:
./spool_read4.pl  0.54s user 0.02s system 102% cpu 0.547 total

不过，我愿意接受更好的解决方案...

【讨论】：