我的Perl脚本运行一个外部程序(采用单个命令行参数)并处理其输出。最初,我是这样做的:
my @result = `prog arg`;
然而,事实证明,该程序有缺陷,在极少数情况下会不可预测地挂起。如果程序在一段时间后没有退出,我该如何终止它?该脚本必须在Windows和Linux中都能工作,我的理解是,警报和分叉在Windows中工作不好(或者根本不好)。
我找到了一个名为IPC::Run的模块,但我无法从它的文档中找到如何正确使用它。:-(我试过这个:
use strict;
use warnings;
use IPC::Run qw(run timeout);
my $in;
my $out;
my $err;
my @result;
my @cmd = qw(prog arg);
run @cmd, $in, $out, $err, timeout (10) or die "@cmd: $?";
push @result, $_ while (<$out>);
close $out;
print @result;
作为一个测试,我创建了一个只休眠60秒的程序,将一个字符串打印到stdout
并退出。当我尝试用上面的代码运行它时,它会挂起60秒(而不是超时中指定的10秒),并以一个奇怪的错误中止:
IPC::Run: timeout on timer #1 at C:/Bin/Unix/Perl/site/lib/IPC/Run.pm line 2956
然后我找到了另一个模块,Proc::Reliable。从描述来看,它似乎正是我想要的。除了它不起作用!我试过这个:
use strict;
use warnings;
use Proc::Reliable;
my $proc = Proc::Reliable->new ();
$proc->maxtime (10);
my $out = $proc->run ("prog arg");
print "$outn";
它确实会在10秒钟后中止子进程。到目前为止,一切都很好。但后来我修改了外部程序,让它只睡了5秒钟。这意味着程序应该在上面代码中指定的10秒超时之前完成,并且它的stdout
输出应该被捕获到变量$out
中。但事实并非如此!上面的脚本没有输出任何内容。
有什么好办法吗?(修复有缺陷的外部程序不是一种选择。)提前感谢。
试试穷人的警报器
my $pid;
if ($^O eq 'MSWin32') {
$pid = system 1, "prog arg"; # Win32 only, run proc in background
} else {
$pid = fork();
if (defined($pid) && $pid == 0) {
exec("proc arg");
}
}
my $poor_mans_alarm = "sleep 1,kill(0,$pid)||exit for 1..$TIMEOUT;kill -9,$pid";
system($^X, "-e", $poor_mans_alarm);
穷人的警报是在一个单独的过程中发出的。每秒钟,它都会检查标识符为$pid的进程是否仍然存在。如果进程不活动,则报警进程退出。如果流程在$time秒后仍然有效,它会向流程发送一个终止信号(我用9使其不可跟踪,用-9取出整个子流程树,您的需求可能会有所不同。kill 9,...
也是可移植的)。
编辑:如何用穷人的警报捕捉过程的输出?如果没有backticks,则无法获取进程id,如果进程超时并被终止,则可能会丢失中间输出。替代方案是
1) 将输出发送到文件,在完成过程时读取文件
$pid = system 1, "proc arg > some_file";
... start poor man's alarm, wait for program to finish ...
open my $fh, '<', 'some_file';
my @process_output = <$fh>;
...
2) 使用Perl的open
启动进程
$pid = open my $proc, '-|', 'proc arg';
if (fork() == 0) {
# run poor man's alarm in a background process
exec($^X, '-e', "sleep 1,kill 0,$pid||exit ...");
}
my @process_output = ();
while (<$proc>) {
push @process_output, $_;
}
当进程自然或非自然结束时,while
循环将结束。
这是我能做的最好的事情。如果有任何关于如何避免在Windows上使用临时文件的想法,我们将不胜感激。
#!/usr/bin/perl
use strict;
use warnings;
use File::Temp;
use Win32::Process qw(STILL_ACTIVE NORMAL_PRIORITY_CLASS);
my $pid;
my $timeout = 10;
my $prog = "prog arg";
my @output;
if ($^O eq "MSWin32")
{
my $exitcode;
my $fh = File::Temp->new ();
my $output_file = $fh->filename;
close ($fh);
open (OLDOUT, ">&STDOUT");
open (STDOUT, ">$output_file" ) || die ("Unable to redirect STDOUT to $output_file.n");
Win32::Process::Create ($pid, $^X, $prog, 1, NORMAL_PRIORITY_CLASS, '.') or die Win32::FormatMessage (Win32::GetLastError ());
for (1 .. $timeout)
{
$pid->GetExitCode ($exitcode);
last if ($exitcode != STILL_ACTIVE);
sleep 1;
}
$pid->GetExitCode ($exitcode);
$pid->Kill (0) or die "Cannot kill '$pid'" if ($exitcode == STILL_ACTIVE);
close (STDOUT);
open (STDOUT, ">&OLDOUT");
close (OLDOUT);
open (FILE, "<$output_file");
push @output, $_ while (<FILE>);
close (FILE);
}
else
{
$pid = open my $proc, "-|", $prog;
exec ($^X, "-e", "sleep 1, kill (0, $pid) || exit for 1..$timeout; kill -9, $pid") unless (fork ());
push @output, $_ while (<$proc>);
close ($proc);
}
print "Output:n";
print @output;
您可能希望使用报警系统调用,如perldoc-f报警。