Run a sub in a perl script based on the time? - perl

I have a perl script that runs as a daemon looping all the time. I want to run a subfunction in a perl script that is based on the time (or timer) so every 2hrs it would run that subfunction and continue with it's loop. I'm thinking getting the epoch time and just checking it a few times through the loop and once it's greater then 2hrs it runs the subfunction. Is there a better way to do this in perl?
Thanks,
LF4

This depends on whether there should be 2 hours since the START of the last subroutine launch, or since the END of last execution.
1) If the latter (2 hours between the end of running the last subroutine and the start of new one), cespinoza's solution is perfectly acceptable (loop infinitely, and call sleep(7200); after executing the subroutine).
my $timeout = 7200;
while (1) {
dostuff();
sleep($timeout);
};
The only problem with this is that it can't handle the case where dostuff() takes forever, e.g. gets stuck - for the discussion of why it's an important situation to consider and approaches to solve, see below.
2) If the former (2 hours between starting points), you have three options, related to handling the subroutine run-time that exceeds 2 hours[0]. Your 3 options, explained in detail below, are to either:
2a) kick off a new subroutine while the old one keeps running (in parallel);
2b) to kick off a new subroutine AFTER the old one finishes;
2c) to kick off a new subroutine but first stop the execution of the prior one.
2a an 2c options require you to set an alarm() for 2 hours, and differ in what happens when an alarm gets triggered.
[0] NOTE: since any subroutine is likely to require at least SOME resources from the PC, there's always a - however small - chance that it would exceed 2 hours, so you have to pick one of those 3 options to handle such a scenario.
2a) Kick off every 2 hours, running in parallel with old execution if not finished.
This option is, essentially, implementing cron functionality.
Anytime you hear the word parallel, you would likely fork off the process.
my $timeout = 7200;
while (1) { # Not tested!
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
if (!defined($child_pid = fork())) {
die "cannot fork: $!\n";
} elsif (!$child_pid) { # Child
dostuff();
exit;
} # Parent continues to sleep for 2 hours
alarm $timeout; # You need it in case forking off take >2hrs
sleep; # forever
};
die unless $# eq "alarm\n"; # propagate unexpected errors
# We don't need to check if $# is true due to forever sleep
}
2b) Kick off every 2 hours, if the old one didn't finish, let it run till it finishes
This can be re-worded as "kick off task, if it finishes faster than 2 hours, sleep for the remainder"
my $timeout = 7200;
while (1) {
my $start = time;
dostuff();
my $end = time;
my $lasted = $end - $start;
if ($lasted < $timeout) {
sleep($timeout - $lasted);
}
};
2c) Kick off every two hours, if the previous one didn't finish, time it out and kill it
Whenever you see logic like this, alarm is obviously the answer.
while (1) {
my $finished = 0;
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 7200;
dostuff();
$finished = 1;
sleep; # forever
};
die unless $# eq "alarm\n"; # propagate unexpected errors
warn "Timed out!!!\n" unless $finished
}
P.S. As cespinoza noted, you need to somehow daemonize the script (ensure it doesn't get killed when you exit the shell that started it), by either Unix means (e.g. launching it as nohup) or Perlish means (search for daemonize + Perl on Stackoverflow for mechanics of that).

Something like crontab would be best to do a timed job like that. However, if you want to run a Perl daemon, you'll have to use some kind of event handler. Two choices off the top of my head are POE and AnyEvent.

You might want to check Schedule::Cron for task planning and execution.

Related

ForkManager SIGINT only kills current process in fork

I want to have all child processes die when I kill a perl process that is using ForkManager. In the code below, if I run it and hit ctrl+c while the sleep line is running, the sleep process is killed, but the print lines are then all simultaneously executed before the script ends. Ideally, I'd like an interrupt to immediately stop all execution. What can I do?
#!/usr/bin/perl -w
use Parallel::ForkManager;
main {
my $fork1 = new Parallel::ForkManager(8);
while (1) {
$fork1->start and next;
system("sleep 15s");
print "Still going!"
$fork1->finish;
}
fork1->wait_all_children;
}
According to perldoc system, system actually ignores both SIGINT and SIGQUIT:
Since SIGINT and SIGQUIT are ignored during the execution of system,
if you expect your program to terminate on receipt of these signals
you will need to arrange to do so yourself based on the return value.
So if you want your processes to stop executing if you SIGINT during the system call, you need to implement that logic yourself:
#!/usr/bin/perl -w
use Parallel::ForkManager;
main {
my $fork1 = new Parallel::ForkManager(8);
while (1) {
$fork1->start and next;
print "Sleeping...";
system("sleep 15s") == 0 or exit($?);
print "Still going!";
$fork1->finish;
}
fork1->wait_all_children;
}
OR the more reasonable approach is the use the Perl built-in sleep:
#!/usr/bin/perl -w
use Parallel::ForkManager;
main {
my $fork1 = new Parallel::ForkManager(8);
while (1) {
$fork1->start and next;
print "Sleeping...";
sleep 15;
print "Still going!";
$fork1->finish;
}
fork1->wait_all_children;
}
First off - using system means you might have something strange happen, because ... then you're allowing whatever you're calling to do stuff to handle signals by itself.
That may be your problem.
However otherwise, what you can do with perl is configure signal handlers - what to do if a signal is recieved by this process. By default - signals are either set to 'exit' or 'ignore'.
You can see what this is currently via print Dumper \%SIG;
However the simplest solution to you problem I think, would be to set a handler to trap SIGINT and then send a kill to your current process group.
The behavior of kill when a PROCESS number is zero or negative depends on the operating system. For example, on POSIX-conforming systems, zero will signal the current process group, -1 will signal all processes, and any other negative PROCESS number will act as a negative signal number and kill the entire process group specified.
$SIG{'INT'} = sub {
kill ( 'TERM', -$$ );
};

regulate execution time of function in perl

I have a command line function I'd like to execute in Perl. However, I only want it to run for up to X seconds. If at X seconds, no result is returned, I want to move on. For instance, if I wanted to do something like
sub timedFunction {
my $result = `df -h`;
return $result;
}
How could I kill the wait for the command line command to finish if it's not returned any values after 3 seconds?
You want to use an alarm.
local $SIG{ALRM} = sub { die "Alarm caught. Do stuff\n" };
#set timeout
my $timeout = 5;
alarm($timeout);
# some command that might take time to finish,
system("sleep", "6");
# You may or may not want to turn the alarm off
# I'm canceling the alarm here
alarm(0);
print "See ya\n";
You obviously don't have to "die" here when the alarm signal is caught. Say get the pid of the command you called and kill it.
Here's the output from the above example:
$ perl test.pl
Alarm caught. Do stuff
$
Notice the print statement didn't execute after the system call.
It's worth noting that it isn't recommended to use alarm to time out a system call unless it's an 'eval/die' pair according to the perldoc.

In Perl is there a way to restart the program currently running from within itself?

I am running a program in Perl that at one point evaluates data in an if statement called from within a subroutine, e.g.
sub check_good {
if (!good) {
# exit this subroutine
# restart program
}
else {
# keep going
}
} # end sub
The problem I have is with exiting and restarting. I know that I can just use exit 0; to exit straight out, but obviously this is not correct if I want to go back to the beginning. I tried calling the subroutine which essentially starts the program, but of course once it has run it will go back to this point again.
I thought about putting it in a while loop, but this would mean putting the whole file in the loop and it would be very impractical.
I don't actually know whether this is possible, so any input would be great.
If you have not changed #ARGV, or you keep a copy of it, you could possibly do something like exec($^X, $0, #ARGV).
$^X and $0 (or $EXECUTABLE_NAME and $PROGRAM_NAME, see Brian's comment below) are the current perl interpreter and current perl script, respectively.
An alternative would be to always have two processes: A supervisor and a worker.
Refactor all your logic into a subroutine called run(or main or whatever). Whn your real logic detect that it needs to restart it should exit with a predefined non-zero exit code (like 1 for example).
Then your main script and supervisor would look like this:
if (my $worker = fork) {
# child process
run(#ARGV);
exit 0;
}
# supervisor process
waitpid $worker;
my $status = ($? >> 8);
if ($status == 1) { ... restart .. }
exit $status; # propagate exit code...
In the simple scenario where you just want to restart once, this might be a bit overkill. But if you at any point need to be able to handle other error scenarios this method might be preferable.
For example if the exit code is 255, this indicates that the main script called die(). In this case you might want to implement some decision procedure wether to restart the script, ignore the error, or escalate the issue.
There are quite a few modules on CPAN implementing such supervisors. Proc::Launcher is one of them and the manual page includes a extensive discussion of related works. (I have never used Proc::Launcher, it is mainly due to this discussion I'm linking to it)
There's nothing to stop you calling system on yourself. Something like this (clearly in need of a tidy), where I pass in a command-line argument to prevent the code calling itself forever.
#!/usr/bin/perl
use strict;
use warnings;
print "Starting...\n";
sleep 5;
if (! #ARGV) {
print "Start myself again...\n";
system("./sleep.pl secondgo");
print "...and die now\n";
exit;
} elsif ((#ARGV) && $ARGV[0] eq "secondgo") {
print "Just going to die straightaway this time\n";
exit;
}

Terminating a system() after certain amount of time in Windows

I'm running a command line application from within the perl script(using system()) that sometimes doesn't return, to be precise it throws exception which requires the user input to abort the application. This script is used for automated testing of the application I'm running using the system() command. Since, it is a part of automated testing, sytem() command has to return if the exception occurs and consider the test to be fail.
I want to write a piece of code that runs this application and if exception occurs it has to continue with the script considering the this test to be failed.
One way to do this is to run the application for certain period of time and if the system call doesn't return in that period of time we should terminate the system() and continue with the script.
(How can I terminate a system command with alarm in Perl?)
code for achieving this:
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
}
but this code doesn't work on windows i did some research on this and found out that SIG doesn't work for windows(book programming Perl).
could some one suggest how could I achieve this in windows?
I would recommend looking at the Win32::Process module. It allows you to start a process, wait on it for some variable amount of time, and even kill it if necessary. Based on the example the documentation provides, it looks quite easy:
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
}
You could also sleep for the appropriate number of seconds and use the kill method in this module. I'm not exactly sure if the NORMAL_PRIORITY_CLASS creation flag is the one you want to use; the documentation for this module is pretty bad. I see some examples using the DETACHED_PROCESS flag. You'll have to play around with that part to see what works.
See Proc::Background, it abstracts the code for both win32 and linux, the function is timeout_system( $seconds, $command, $arg, $arg, $arg )

Killing an application started using system() in Perl

I am trying to run an application inside a Perl script using system(). The application I'm running gets stuck sometimes (it enters some kind of infinite loop). Is there a way I can know if this application is stuck and kill it to continue with the Perl script?
I'm trying to do something like this:
start testapp.exe;
if(stuck with testapp.exe) {
kill testapp.exe;
}
Determining if "it is stuck in infinite loop" is called Halting Problem and is undecidable.
If you want to kill it, you will have to fork the application using fork and then kill it from the other fork, if it is going for too long.
You can determine if the proccess is going for too long by this
use POSIX ":sys_wait_h";
waitpid($pid, WNOHANG)>0 #waitpid returns 0 if it still running
at least, according to this manual page
I am not sure how well it works on various systems, you can try it out.
Not a direct answer, but I can recommend using forks module if you want to fork with ease, but it works only on UNIX systems (not windows).
OK, more helping code :) It works in UNIX, according to perlfork perldoc, it should work on Windows exactly the same way.
use warnings;
use strict;
use POSIX ":sys_wait_h";
my $exited_cleanly; #to this variable I will save the info about exiting
my $pid = fork;
if (!$pid) {
system("anything_long.exe"); #your long program
} else {
sleep 10; #wait 10 seconds (can be longer)
my $result = waitpid(-1, WNOHANG); #here will be the result
if ($result==0) { #system is still running
$exited_cleanly = 0; #I already know I had to kill it
kill('TERM', $pid); #kill it with TERM ("cleaner") first
sleep(1); #wait a bit if it ends
my $result_term = waitpid(-1, WNOHANG);
#did it end?
if ($result_term == 0) { #if it still didnt...
kill('KILL', $pid); #kill it with full force!
}
} else {
$exited_cleanly = 1; #it exited cleanly
}
}
#you can now say something to the user, for example
if (!$exited_cleanly) {...}
system("start testapp")
is short for
system("cmd", "/c", "start testapp")
Perl just knows about cmd; it doesn't know anything about start, much less about testapp. system is not the tool you want. That's the first problem.
The second problem is that you haven't defined what it means to be "stuck". If you want to monitor a program, it needs a heartbeat. A heartbeat is a periodic activity that can be externally examined. It can be writing to a pipe. It can be changing a file. Anything.
The monitoring program listens for this heartbeat, and presumes the program is dead if the heart stops beating, so to speak.
"Killing" is done using signals in unix, but it's done using TerminateProcess in Windows. The third problem is that Perl core does not give you access to that function.
The solution to the first and third problem is Win32::Process. It allows you to launch a process in the background, and it also allows you to terminate it.
Creating a heartbeat is up to you.
Here is one way you can handle the problem if you know that testapp should not take more than N seconds to do its thing, then you can use a timeout to kill the app by way of IPC::Run.
In the example below there is a timeout of 1 second which kills the sleep 10 command that takes too long (longer than the timeout of 1 second). If this doesn't do what you want, then you should provide more information about how you can detect that testapp.exe is "stuck".
#!/usr/bin/env perl
use IPC::Run qw( run timeout );
eval { # if (stuck with testapp.exe for more than N seconds)
#cmd = ('sleep', '10'); # this could be testapp.exe instead of sleep
run \#cmd, \$in, \$out, \$err, timeout( 1 ) or die "test"; # start testapp.exe
print "do stuff if cmd succeeds\n";
};
print "more stuff to do afterwards whether or not command fails or succeeds\n";
You can't determine that the application is stuck if you execute it like that, because the system statement won't return until the application terminates.
So, at least, you need to start the test application so it can run asynchronously from the Perl script that is to monitor it.
Having resolved that part of the problem, you have to establish a mechanism that will allow the monitoring Perl script to determine that the application is stuck. That is a non-trivial exercise, and likely system dependent, unless you adopt a simple expedient such as requiring the application to write a heart-beat indication somewhere, and the Perl script monitors for the heart-beat. For example (not necessarily a good example), the application could write the current time into a file identified by its PID, and the Perl script could monitor the file to see if the heart-beat is sufficiently recent. Of course, this assumes that the 'infinite loop' doesn't include code that writes to the heart-beat file.