Start stop reset timer in perl - perl

Is there a start/stop timer in Perl. I had tried AnyEvent but this is like a one time or recurring timer. Once set, I can reset the timeout interval.
I have a requirement where I have to reset the timer if an event occurs within the timer timeout interval. Is there any Perl module that does this job?
Thanks in advance.

UPDATE
This question actually prompted quite a bit of discussion on the #mojo IRC channel. The end result is that, barring some unforseen problems, the upcoming Mojolicious 4.0 release will include a new reactor method again which can restart timers. It turns out that this new method (inspired partially by this question) provides a massive performance increase when used internally by Mojolicious in a certain case (high load with high concurrency). Once 4.0 is released, try this updated example version of the second example below:
#!/usr/bin/env perl
use Mojo::Base -strict;
use Mojo::IOLoop;
my $loop = Mojo::IOLoop->singleton;
my $now = 1;
$loop->recurring( 1 => sub { print $now++ . "\n" } );
my $timer = $loop->timer( 3 => \&boom );
$loop->timer( 2 => sub {
print "Event resets. No boom yet\n";
$loop->reactor->again($timer);
});
$loop->start;
sub boom {
print "Boom!\n";
$loop->stop;
}
ORIGINAL
Here is a quick and dirty using the Mojo::IOLoop directly. If this is run inside a server you probably don't need the start and stop methods. Basically the there is a countdown variable which may be reset elsewhere and the recurring timer checks to see if that countdown has expired before it goes boom.
#!/usr/bin/env perl
use Mojo::Base -strict;
use Mojo::IOLoop;
my $loop = Mojo::IOLoop->singleton;
my $now = 1;
my $timeout = 3;
$loop->recurring( 1 => sub {
print $now++ . "\n";
boom() unless $timeout--;
});
$loop->timer( 2 => sub {
print "Event resets. No boom yet\n";
$timeout = 3;
});
$loop->start;
sub boom {
print "Boom!\n";
$loop->stop;
}
The above method is more efficient if you expect that you are going to have many resets. Here is another example which is a less efficient but more direct example. In this case, the idea is to keep the id of the timer so you can remove it and add another. This effectively resets the timer.
#!/usr/bin/env perl
use Mojo::Base -strict;
use Mojo::IOLoop;
my $loop = Mojo::IOLoop->singleton;
my $now = 1;
$loop->recurring( 1 => sub { print $now++ . "\n" } );
my $timer = $loop->timer( 3 => \&boom );
$loop->timer( 2 => sub {
print "Event resets. No boom yet\n";
$loop->remove($timer);
$timer = $loop->timer( 3 => \&boom );
});
$loop->start;
sub boom {
print "Boom!\n";
$loop->stop;
}
Note that the recurring event used here is just to show the elapsed time and isn't important to the flow.

Related

What is best way in Perl to set a timer to stop long-running process?

I've got an application that invokes a potentially long-running process. I want my program, the caller of this process, to cancel it at any given point and move on to the next entry when a time limit is exceeded. Using Perl's AnyEvent module, I tried something like this:
#!/usr/bin/env perl
use Modern::Perl '2017';
use Path::Tiny;
use EV;
use AnyEvent;
use AnyEvent::Strict;
my $cv = AE::cv;
$cv->begin; ## In case the loop runs zero times...
while ( my $filename = <> ) {
chomp $filename;
$cv->begin;
my $timer = AE::timer( 10, 0, sub {
say "Canceled $filename...";
$cv->end;
next;
});
potentially_long_running_process( $filename );
$cv->end;
}
$cv->end;
$cv->recv;
exit 0;
sub potentially_long_running_process {
my $html = path('foo.html')->slurp;
my #a_pairs = ( $html =~ m|(<a [^>]*>.*?</a>)|gsi );
say join("\n", #a_pairs);
}
The problem is the long-running processes never time out and get canceled, they just keep on going. So my question is "How do I use AnyEvent (and/or related modules) to time out a long-running task?"
You have not mentioned the platform you are running this script on, but if it is running on *nix, you can use the SIGALRM signal, something like this:
my $run_flag = 1;
$SIG{ALRM} = sub {
$run_flag = 0;
}
alarm (300);
while ($run_flag) {
# do your stuff here
# note - you cannot use sleep and alarm at the same time
}
print "This will print after 300 seconds";

How do I properly shut down a Mojolicious::Lite server?

In a Mojolicious::Lite app I have a route that I want to kill the server and redirect to another site. Here is the snippet.
my $me = $$;
get '/kill' => sub {
my $self = shift;
$self->res->code(301);
$self->redirect_to('http://www.google.com');
$self->app->log->debug("Goodbye, $name.");
# I need this function to return so I delay the kill a little.
system("(sleep 1; kill $me)&");
};
This code does what I want, but it doesn't feel right. I have tried $self->app->stop but that is not available.
Is there a proper technique I should be using to get access to the server?
Update 2021:
This answer was referred to recently in an IRC discussion, so an update is warranted. The response below was a mechanism that I had used in a very specific case. While it may still be useful in rare cases, the more correct manner of stopping a service would be
https://docs.mojolicious.org/Mojo/IOLoop#stop_gracefully
or https://docs.mojolicious.org/Mojo/Server/Daemon#SIGNALS for a single-process server or https://docs.mojolicious.org/Mojo/Server/Prefork#MANAGER-SIGNALS for preforking
Original:
There are several ways to do this, of course.
Probably the best, is to simply attach a finish handler to the transaction:
#!/usr/bin/env perl
use Mojolicious::Lite;
get '/kill' => sub {
my $c = shift;
$c->redirect_to('http://google.com');
$c->tx->on( finish => sub { exit } );
};
app->start;
The method most like your example would be to setup a Mojo::IOLoop timer which would wait a few seconds and exit.
#!/usr/bin/env perl
use Mojolicious::Lite;
use Mojo::IOLoop;
get '/kill' => sub {
my $c = shift;
$c->redirect_to('http://google.com');
my $loop = Mojo::IOLoop->singleton;
$loop->timer( 1 => sub { exit } );
$loop->start unless $loop->is_running; # portability
};
app->start;
Joel mentioned Mojo::IOLoop, so here's what I've used for a simple Mojo Lite throwaway app:
get '/shutdown' => sub ($c) {
$c->render(text => "Shutting down" );
$c->tx->on( finish => sub { Mojo::IOLoop->stop_gracefully } );
};
Sending signals also works since this is a single process program:
get '/shutdown' => sub ($c) {
$c->render(text => "Shutting down" );
$c->tx->on( finish => sub { kill 'TERM', $$ } );
};

What does send/recv/begin/end mean for AnyEvent's condvar?

I'm at a loss what it means, though I'm read several examples on it:
#!/usr/bin/perl
use strict;
use AnyEvent;
my $cv = AnyEvent->condvar( cb => sub {
warn "done";
});
for my $i (1..10) {
$cv->begin;
my $w; $w = AnyEvent->timer(after => $i, cb => sub {
warn "finished timer $i";
undef $w;
$cv->end;
});
}
$cv->recv;
Can anyone explain in more detail what send/recv/begin/end does?
UPDATE
my $i = 1;
my $s = sub {
print $i;
};
my $i = 10;
$s->(); # 1
In the code you provided, the condvar is there to prevent the program from exiting prematurely. Without the recv, the program would end before any timers would have a chance to fire. With the recv, all ten timers must fire before recv returns.
recv will block if send has never been called. It will unblock when send is called.
begin and end is an alternative to using send. When there has been as many end calls as there has been begin calls, a send occurs.
AnyEvent

What else can i do 'sleep' when the sleep() can't work well with alarm?

There are many documents say "you should avoid using sleep with alarm, since many systems use alarm for the sleep implementation". And actually, I'm suffering with this problem.
So does anyone can help me that what else i can do 'sleep' when the sleep() can't work well with alarm? I have already tried 'usleep' of the Time::HiRes module, and select() function. But they didn't work either.
Seeing as you're being interrupted by alarms, and so can't reliably use sleep() or select(), I suggest using Time::HiRes::gettimeofday in combination with select().
Here's some code that I've not tested. It should resist being interrupted by signals, and will sleep for the desired number of seconds plus up to 0.1 seconds. If you're willing to burn more CPU cycles doing nothing productive, you can make the resolution much better:
...
alarm_resistant_sleep(5); # sleep for 5 seconds, no matter what
...
use Time::HiRes;
sub alarm_resistant_sleep {
my $end = Time::HiRes::time() + shift();
for (;;) {
my $delta = $end - Time::HiRes::time();
last if $delta <= 0;
select(undef, undef, undef, $delta);
}
}
You can try AnyEvent:
use AnyEvent;
my $cv = AnyEvent->condvar;
my $wait_one_and_a_half_seconds = AnyEvent->timer(
after => 1.5,
cb => sub { $cv->send }
);
# now wait till our time has come
$cv->recv;
You can sleep on a new process via system:
system ( "sleep", 5 );
Or did I misunderstand the question?
When using (from MySQL forum)
use Sys::SigAction qw( set_sig_handler );
eval {
my $hsig = set_sig_handler( 'ALRM', sub { my $canceled = 1; die; }, { mask=>[ qw( INT ALRM ) ] ,safe => 0 } );
alarm($timeout);
...
alarm(0);
}
I noticed that any subsequent calls made to sleep($delay) with $timeout shorter than $delay would end up with the script execution being terminated, and the print of "Alarm clock".
The workaround I've found is to call alarm() again but with an improbably large value (3600), and cancel that alarm right after.
eval {
alarm(3600);
print " .... Meeeep ...."; # Some trace
alarm(0);
};
Then I can use sleep() with no interference anymore.
Example below (live code snippet):
sub unmesswithsleep {
eval {
alarm(3600);
&tracing (8, " .... Meeeep ....");
alarm(0);
};
}
sub lockDBTables {
return (0) unless ($isdbMySQLconnect);
my $stm = qq {
LOCK TABLES
myBIGtable WRITE
};
my $timeout = 60; # This is the timer set to protect against deadlocks. Bail out then.
eval {
my $h = set_sig_handler( 'ALRM', sub { my $canceled = 1; die; }, { mask=>[ qw( INT ALRM ) ] ,safe => 0 } );
alarm($timeout);
my $res = $dbmyh->do($stm) + 0;
alarm(0); # Reset alarm
};
if ( $# =~ m/Die/i ) {
$isdbTabledlocked = 0;
&tracerr (0, "FATAL: Lock on Tables has NOT been acquired within ${timeout}s. Lock is set to <$isdbTabledlocked>.");
&unmesswithsleep(); # MUST be called each time alarm() is used
return (0);
} else {
$isdbTabledlocked = 1;
&tracing (2, " Good: Lock on Tables has been acquired in time. Lock is set to <$isdbTabledlocked>.");
&unmesswithsleep(); # MUST be called each time alarm() is used
return (1);
}
# Can use sleep() now.
}
try
print "Start\n";
select undef, undef, undef, 1;
print "End\n";
This will sleep for 1 second.
It sounds like your code that sleeps is being interrupted by some code that sets an alarm. This is by design so you're seeing the expected behavior. In other words an alarm *should always interrupt a sleep call.
If you're looking for a pure perl way to sleep without being interrupted by an alarm you can do this by installing your own alarm signal handler. This way when your code gets an alarm it won't interrupt your processing.
However, an important caveat is that this will delay any alarm that was set by other code. The other code will receive the alarm late; after your code completes. This means that if you want to play well with others you're better off using one of the other solutions.
Here is an example:
#!/usr/bin/perl
use POSIX;
use strict;
use warnings;
# set an alarm
print "Setting alarm\n";
alarm 1;
my $old_alarm;
my $snoozed;
{
# store the previous alarm handler (if any)
$old_alarm = $SIG{ALRM};
# override the alarm handler so that we don't
# get interrupted
local $SIG{ALRM} = sub {
print "got alarm; snoozing\n";
# record the fact that we caught an alarm so that
# we can propagate it when we're done
$snoozed++;
};
# sleep for a while.
for (1 .. 3) {
print "z" x $_ ,"\n";
sleep 1;
}
}
# replace the old sleep handler;
$SIG{ALRM} = $old_alarm
if $old_alarm;
# if we had to snooze fire an immediate alarm;
if ($snoozed) {
POSIX::raise(POSIX::SIGALRM);
}
The documentation you reference hints at but does not describe a different symptom. The main thing you need to worry about when sleep is implemented via alarm is having your alarm reset when someone calls sleep.
*Apparently there are some versions of perl (e.g.: old Win32) where an alarm doesn't interrupt sleep.

How do I make a CGI::Fast based application kill -HUP aware?

I have application that works using Perl's CGI::Fast.
Basically mainloop of the code is:
while (my $cgi = CGI::Fast->new() ) {
do_whatever( $cgi );
}
Now, I wanted to add ability to kill it, but without disrupting currently processed request. To do so, I added handling to SIGHUP. More or less along the lines:
my $sighupped = 0;
$SIG{ 'HUP' } = sub { $sighupped = 1; };
while (my $cgi = CGI::Fast->new() ) {
do_whatever( $cgi );
exit if $sighupped;
}
Which works really great when it comes to "not disturbing process while it handles user request". But, if the process is waiting for new request the sighup-based exit will not be executed until it will finally get some request and process it.
It there any workaround for this? What I would like to achieve it to make the script exit immediately if the HUP (or other signal, it can be changed) reaches it while waiting for request.
You could use the block version of the eval function and the alarm function to add a timeout to Fast::CGI. In the code below I have set a five second timeout. If it times out it will go back to the start of the loop which will check to see if $continue has been set to zero yet. If it hasn't then it we start a new CGI::Fast object. This means that a maximum of five seconds will go by after you send a HUP before the code will start to stop if it was waiting for a new CGI::Fast object (the timeout has no affect on the rest of the loop).
my $continue = 1;
$SIG{HUP} = sub { $continue = 0 };
while ($continue) {
my $cgi;
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm 5; #set an alarm for five seconds
$cgi = CGI::Fast->new;
alarm 0; #turn alarm off
};
if ($#) {
next if $# eq "timeout\n"; #we will see the HUP signal's change now
#died for a reason other than a timeout, so raise the error
die $#;
}
last unless defined $cgi; #CGI::Fast has asked us to exit
do_stuff($cgi);
}
#clean up
You could redeclare your SIGnals based on where the handler is.
If you're outside fast-cgi while loop or inside the fast-cgi polling and thus not in
the event loop terminate (basically the default). If you're inside the eventloop logic wait for logic to end and terminate.
Pardon my lack of an editor at the moment.
$inlogic=0;
$hupreq=0;
SIG{SIGHUP}={ exit unless($inlogic); $hupreq=1;}
while()
{
$inlogic=1;
function();
$inlogic=0;
exit if($hupreq);
}