Perl 杀死挂起的子进程

Perl 杀死挂起的子进程,perl,perl-module,Perl,Perl Module,我的Perl脚本运行一个外部程序(只接受一个命令行参数)并处理其输出。最初,我是这样做的: my @result = `prog arg`; 然而,事实证明,该程序有缺陷,在极少数情况下会意外挂起。如果程序在一段时间后还没有退出,我如何杀死它?脚本必须在Windows和Linux中都能工作,据我所知,警报和分叉在Windows中不能很好地工作(或者根本不能工作) 我找到了一个名为的模块,但我无法从其文档中找到如何正确使用该模块的方法:-(我试过: use strict; use warning

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

my @result = `prog arg`;
然而,事实证明,该程序有缺陷,在极少数情况下会意外挂起。如果程序在一段时间后还没有退出,我如何杀死它?脚本必须在Windows和Linux中都能工作,据我所知,警报和分叉在Windows中不能很好地工作(或者根本不能工作)

我找到了一个名为的模块,但我无法从其文档中找到如何正确使用该模块的方法:-(我试过:

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;
use strict;
use warnings;
use Proc::Reliable;

my $proc = Proc::Reliable->new ();
$proc->maxtime (10);
my $out = $proc->run ("prog arg");
print "$out\n";
然后我找到了另一个模块,。从描述来看,它似乎正是我想要的。只是它不起作用!我尝试了以下方法:

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;
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秒超时之前完成,其
标准输出应该捕获到变量
$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,…
也是可移植的)

编辑:如何捕获穷人警报流程的输出? 如果进程超时并被终止,则无法获取进程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>;
...

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;
!/usr/bin/perl
严格使用;
使用警告;
使用File::Temp;
使用Win32::Process qw(仍处于活动状态的正常优先级类);
我的$pid;
我的$timeout=10;
my$prog=“prog arg”;
我的@output;
如果($^O eq“MSWin32”)
{
我的$exitcode;
my$fh=File::Temp->new();
我的$output_file=$fh->filename;
收盘价($fh);
打开(旧的,“>&STDOUT”);
打开(STDOUT,“>$output_file”)| | die(“无法将STDOUT重定向到$output_file。\n”);
Win32::Process::Create($pid,$^X,$prog,1,普通优先级等级,'.')或die Win32::FormatMessage(Win32::GetLastError());
对于(1..$timeout)
{
$pid->GetExitCode($exitcode);
最后一个if($exitcode!=仍处于活动状态);
睡眠1;
}
$pid->GetExitCode($exitcode);
$pid->Kill(0)或在($exitcode==仍处于活动状态)的情况下die“无法终止'$pid'”;
关闭(标准输出);
打开(标准输出,“>&OLDOUT”);
关闭(旧的);

打开(文件,“您可能希望使用perldoc-f alarm中的报警系统调用。

您是否尝试从可靠对象打印stderr、status和msg的输出?设置调试时会发生什么?
Proc::Reliable::debug($level);
如果我执行
Proc::Reliable::debug(1);
,脚本只输出
Proc::Reliable>尝试0:'prog arg'
和其他内容。从
$out
没有输出(当然,如果我手动运行程序
prog arg
,我会得到输出。)恐怕我真的不明白你的代码在做什么,但一旦我用一个合适的值替换了
$TIMEOUT
,它就基本上起作用了——从某种意义上说,它确实会在指定的秒数之后终止子进程,并让它完成运行,如果它终止的速度比这快的话。但是,我如何从子进程收集输出呢进程?与反勾号不同,
system()
不允许我读取它运行的程序的标准输出。可能是管道的问题?我不希望显式使用临时文件,因此解决方案1)已过时。解决方案2)当我问是否可以使用管道时,我正在寻找它。它几乎满足了我的需要。它唯一的问题是,它总是需要指定的超时时间才能运行-即使子进程终止的速度快于此。至少在Windows上是这样;我现在无法在Linux上测试它。解决方案2)在Linux上正常工作-它会终止无论是在超时之后,还是在子进程终止之后,以先到者为准。但是,我仍然需要一个在Windows上也能正常工作的解决方案;正如上面提到的,当前您的解决方案总是在指定的超时时间内运行。
Proc::Reliable
的作者确认它在Wind上不起作用ows。你的代码不能在Windows上运行的原因是因为有分叉,很明显,管道是作为线程实现的,而不是作为单独的进程实现的。线程保持“活动”(即使在退出之后)只要其父进程没有终止,那么您的代码
kill 0,$pid
总是返回1。我知道如何使用
Win32::process
启动一个真正的进程(并在指定的超时后终止它,或者在超时到期之前让它完成)但现在我不知道如何捕捉它的
stdout
:headbang: