[英]Perl: avoid greedy reading from stdin?
考慮以下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問題。 這是一個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;
}
我有好消息和壞消息。
好消息是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 read: A And here's what cat gets: B C D
壞消息是你得到一次轉換:如果你試圖重復讀取當時的貓,那么第一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 read: A 1: And here's what cat gets: B C D 2: Perl read: <undefined> 2: And here's what cat gets:
今天我想我已經找到了我需要的東西: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();
奇跡般有效 ;)
這是我發現的次優方式:
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();
它不需要任何提示的知識,但是因為它等待至少兩秒鍾而很慢。 另外,我不明白為什么需要第二個計時器(完成后不會返回)。
有人知道更好的解決方案嗎?
最后我得到了以下解決方案。 仍然遠非最佳,但它的工作原理。 即使在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
不過,我願意接受更好的解決方案......
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.