Question

我的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 "$out\n";

它确实在10秒后中止了子进程。到现在为止还挺好。但后来我修改了外部程序，让它只睡了5秒钟。这意味着程序应该在上面代码中指定的10秒超时之前完成，并且应该将其stdout输出捕获到变量$out中。但事实并非如此！上面的脚本没有输出任何内容。

任何想法如何正确地做到这一点？（修复有缺陷的外部程序不是一种选择。）在此先感谢。

Answer 1

尝试穷人的闹钟

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秒后仍处于活动状态，它会向进程发送一个kill信号（我使用9来使其无法处理，-9用于取出整个子进程树，你的需求可能会有所不同。kill 9,...也是便携式）。

编辑：如何使用穷人的闹钟捕获进程的输出？不使用反引号 - 那么你就无法获得进程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循环将在过程结束时自然或不自然地结束。

Answer 2

这是我能做的最好的事情。任何有关如何避免在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;

Answer 3

您可能希望在perldoc -f警报中使用警报系统调用。

杀死一个挂着孩子的过程

3 个答案: