4

次の 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 で入力バッファリングをオフにできますか? または、端末を「模倣」する方法でデータをスプールできますか?

4

5 に答える 5

2

今日、必要なものを見つけたと思います。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();

魅力のように動作します;）

于 2010-09-15T11:38:23.947 に答える
2

This is not a Perl problem. It is a UNIX/shell problem. When you run a command without pipes you are in line buffering mode, but when you redirect with pipes, you are in block buffering mode. You can see this by saying:

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

This C program has the same problem:

#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;
}
于 2010-09-13T11:13:12.773 に答える
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
ハ
D

悪いニュースは、スイッチオーバーが 1 回だけ発生することです。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
ハ
D
2: Perl 読み取り: <未定義>
2: そして、ここに猫が得るものがあります:
于 2010-09-13T13:36:27.193 に答える
0

これが私が見つけた次善の方法です：

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;

さらに入力を待つ前に、プログラムが発する「プロンプト」を知る必要があるという意味で、これは最適ではありません。

もう1つの次善の解決策は、次のとおりです。

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();

プロンプトの知識は必要ありませんが、少なくとも2秒待機するため低速です。また、なぜ2番目のタイマーが必要なのかわかりません（それ以外の場合は終了は戻りません）。

誰かがより良い解決策を知っていますか？

于 2010-09-13T09:21:32.453 に答える
0

最後に、次の解決策になりました。まだ最適にはほど遠いですが、うまくいきます。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;

使用例 (gbacon のケースをテストするためにわずかに変更された read.pl を使用):

$ 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

それでも、私はより良い解決策を受け入れています...

于 2010-09-14T07:50:51.867 に答える