Question

我正在运行perl脚本中的命令行应用程序（使用system（）），有时候不会返回，确切地说它抛出异常，需要用户输入才能中止应用程序。此脚本用于使用system（）命令自动测试我正在运行的应用程序。因为它是自动化测试的一部分，所以如果发生异常，sytem（）命令必须返回并认为测试失败。

我想编写一段运行此应用程序的代码，如果发生异常，则必须继续使用脚本，并考虑此测试失败。

执行此操作的一种方法是运行应用程序一段时间，如果系统调用未在该段时间内返回，则应终止system（）并继续执行脚本。（How can I terminate a system command with alarm in Perl?）

实现此目的的代码：

my @output;
eval {
    local $SIG{ALRM} = sub { die "Timeout\n" };
    alarm 60;
    return = system("testapp.exe");
    alarm 0;
};
if ($@) {
    print "Test Failed";
} else {
    #compare the returned value with expected
}

但是这段代码在windows上不起作用我对此做了一些研究，发现SIG不能用于windows（书籍编程Perl）。有人可能会建议我如何在Windows中实现这一目标？

Answer 1

我建议查看Win32::Process模块。它允许您启动一个进程，等待一段可变的时间，甚至在必要时将其终止。根据文档提供的示例，它看起来很简单：

use Win32::Process;
use Win32;

sub ErrorReport{
    print Win32::FormatMessage( Win32::GetLastError() );
}

Win32::Process::Create($ProcessObj,
                       "C:\\path\\to\\testapp.exe",
                       "",
                       0,
                       NORMAL_PRIORITY_CLASS,
                       ".")|| die ErrorReport();

if($ProcessObj->Wait(60000)) # Timeout is in milliseconds
{
    # Wait succeeded (process completed within the timeout value)
}
else
{
    # Timeout expired. $! is set to WAIT_FAILED in this case
}

您也可以睡眠适当的秒数，并使用此模块中的kill方法。我不确定NORMAL_PRIORITY_CLASS创建标志是否是您要使用的标志;这个模块的文档非常糟糕。我看到一些使用DETACHED_PROCESS标志的示例。你将不得不玩这个部分来看看它有用。

Answer 2

参见Proc::Background，它抽象了win32和linux的代码，函数为timeout_system( $seconds, $command, $arg, $arg, $arg )

在Windows中经过一段时间后终止系统（）

2 个答案: