perl - 杀死一个挂起的子进程

Question

我的 Perl 脚本运行一个外部程序(它接受一个命令行参数)并处理它的输出。最初，我是这样做的:

my @result = `prog arg`;

但是，事实证明该程序存在错误并且在极少数情况下会意外挂起。如果程序在一定时间后没有退出，我该如何杀死程序？该脚本必须在 Windows 和 Linux 中都可以工作，据我了解，警报和 fork 在 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 秒。这意味着程序应该在上述代码及其 stdout 中指定的 10 秒超时之前完成。输出应被捕获到变量 $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 秒后仍然处于事件状态，它会向进程发送终止信号(我使用 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当过程自然或不自然地结束时，循环将结束。