Hello List,
I am trying to a write a simple subroutine in perl to take a command as
argument, execute the command, if the command does not complete with in
specified timeout interval, kill the process. If the program get completed
within timeout interval, then return its output to the calling routine.
I did it in Unix without any problem, now I am trying to do it in Windows
(ActivePerl 5.6.1), but windows does not support alarm functions, so is
there a way to achieve it in Windows? The Win32::Process module may not work
for me because it does not give the output of the executed program back.
Here is the code I tried doing, it work well but I think I am really messing
up with Mutex, so the program says it is timed out but it is not exiting.
Can anyone suggest any correction or a better way to do it...Thanks in
advance
#!/usr/local/bin/perl
#
# set alarm signal to die with timeout message
use Win32;
use Win32::Mutex;
use Win32::IPC;
use Win32::Process;
# timeout by creating a mutex and spawning a child process
# let the child lock the mutex first. Attempt lock on
# the mutex and timeout after $timeout period. The child
# should release the mutex upon completion of the command
# so if the parent could not get the mutex during timeout
# period, then it means the child is still running. Kill
# the child and return the status.
# if you are able to get the lock on mutex, then it means
# the command got completed. The output is available in
# the output_ref.
sub timeout {
my ($cmd, $timeout, $output_ref) = @_;
# create a new mutex
$mutex = Win32::Mutex->new;
if (not defined($pid = fork())) {
warn "can not fork: $!\n";
return;
}
elsif ($pid) {
# parent process
# wait for some time and request lock on mutex
Win32::Sleep(1000);
if ($rc = $mutex->wait($timeout * 1000) == 0) {
# timed out
# kill the child process and return
Win32::Process::KillProcess($pid, 0);
$mutex->wait(0);
$mutex->release;
return 0;
}
elsif ($rc > 0) {
# completed
Win32::Process::KillProcess($pid, 0);
$mutex->release;
return 1;
}
else {
# negative value indicates the mutex is abandoned
Win32::Process::KillProcess($pid, 0);
$mutex->wait(0);
$mutex->release;
return -1;
}
}
else {
# Child process
# get a lock on mutex and run the command
$mutex->wait(0);
open(CMD, "$cmd|") or die "Error running $cmd: $!\n";
@$output_ref = <CMD>;
close(CMD);
#release the lock
$mutex->release;
}
}
if (&timeout("ping -t tmrprod100", 1, \@output)) {
print @output;
}
else {
print "timed out...\n";
}
Venkatesan Saranathan
Application Automation
Target Corporation.
Ph. 612-304-3479
email. [EMAIL PROTECTED]
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
