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

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

Related

alarm does not seem to fire if I set $SIG{ALRM}

I'm trying to implement an alarm in my Perl backend process so that it will terminate if it gets stuck for too long. I tried to implement the code given on the alarm documentation page on Perldoc (this is verbatim from the documentation other than the line that calls my program's key subroutine instead of the sample line in the documentation):
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
&FaithTree::Backend::commandLine({ 'skipWidgets' => $skipWidgets, 'commandLineId' => $commandLineId, 'force' => $force });
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
# didn't
}
Given this code, nothing happens when the alarm should have timed out. On the other hand, if I remove the custom definition for $SIG{ALRM} (which, again, came straight from the Perl documentation) the alarm does fire, just without the custom handler.
I'm wondering if the fact that I'm using Thread::Queue is playing a role in the alarm failing, but that doesn't explain why it works so long as I skip redefining $SIG{ALRM}.
Here's a minimal, runnable version with subroutine that is intentionally an infinite loop for testing:
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm 1;
&FaithTree::Test::Backend::commandLine({ 'skipWidgets' => $skipWidgets, 'commandLineId' => $commandLineId, 'force' => $force });
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
exit;
}
package FaithTree::Test::Backend;
use File::Tail;
use threads;
use threads::shared;
use Thread::Queue;
sub commandLine {
our $N //= 4;
my $Q = new Thread::Queue;
my #kids = map threads->create( \&FaithTree::Test::Backend::fetchChild, $Q ), 1 .. $N;
my #feeds = ( "1","2","3","4" );
foreach my $feed (#feeds) {
$Q->enqueue( $feed );
}
$Q->enqueue( ( undef ) x $N );
$_->join for #kids;
}
sub fetchChild {
print "Test";
# Access queue.
my $Q = shift;
#What is my thread id?
my $tid = threads->tid();
my ($num, $num2);
for ( ; ; ){
if ($num2 == 10000) {
say STDERR $tid . ': ' . $num;
$num2 = 0;
}
$num++;
$num2++;
}
return 1;
}
If you comment out the $SIG{ALRM} line, it will terminate when the alarm is set to time out. If you leave it in place, it will never terminate.
Signals and threads don't mix well. You might want to rethink your use of signals. For example, you could move all the thread stuff to a child process.
Signal handlers are only called between Perl ops. The main thread is in a call to XS sub thread->join, and the signal handler will be called once join returns.
Most blocking system calls can be interrupted (returning error EINTR), so it might be possible to write a signal-aware version of join. Except I seem to remember pthread functions not being interruptible, so maybe not.
In this particular case, you could have the threads signal the main thread when they are over using a system that allows the main thread to block until the a signal occurs or a timeout has occured. cond_signal/cond_timedwait is such a system.
use Sub::ScopeFinalizer qw( scope_finalizer );
use Time::HiRes qw( time );
my $lock :shared;
my $threads_remaining = $N;
my $Q = new Thread::Queue;
my #threads;
{
lock $lock;
for (1..$N) {
++$threads_remaining;
push #threads, async {
my $guard = scope_finalizer {
lock $lock;
--$threads_remaining;
cond_signal($lock);
};
worker($Q);
}
}
}
my $max_end_time = time + 1;
# ...
{
lock $lock;
while ($threads_remaining) {
if (!cond_timedwait($lock, $max_end_time)) {
# ... Handle timeout ...
}
}
}
$_->join for #threads;

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";

Perl how to join all threads

My code is like below:
use threads;
use threads::shared;
use Thread::Queue;
my $q = Thread::Queue->new();
my #threads = ();
my $run :shared = 1;
$SIG{'TERM'} = sub {
$run = 0;
$q->enqueue('exit');
foreach(#threads){
$_->join();
}
};
push #threads, threads->create(proc1);
push #threads, threads->create(proc2);
sub proc1 {
while($p = $q->dequeue()){
if($p eq 'exit'){
last;
}
.....
}
$q->end();
threads->exit();
}
sub proc2 {
while($run){
.....
}
}
On TERM signal im trying to wait till all threads are ended. However, whenever I pass TERM signal my program gets terminated with an error
Segmentation fault
How to fix this ?
Assuming threads->create(proc1) even works (and that would only be because you didn't use use strict; as you should), then your program exits immediately after creating the threads. You need to have your main thread wait for the children threads to finish.
Fixing that problem (and applying some simplifications) results in the following:
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue 3.01 qw( );
my $q = Thread::Queue->new();
my $run :shared = 1;
$SIG{TERM} = sub {
print("Received SIGTERM. Shutting down...\n");
$run = 0;
$q->end();
};
print("$$\n");
threads->create(\&proc1);
threads->create(\&proc2);
$_->join() for threads->list();
sub proc1 {
while(my $p = $q->dequeue()) {
sleep 1; # Placeholder
}
}
sub proc2 {
while($run){
sleep 1; # Placeholder
}
}
I don't get a seg fault, but the program doesn't exit either. The signal handler is simply not called. It's because Perl is waiting for join to return before calling the signal handler. You can solve that by polling the list of joinable threads. In other words, replace
$_->join() for threads->list();
with
my $running_threads = 2;
while ($running_threads) {
for my $thread (threads->list(threads::joinable)) {
$thread->join();
$running_threads--;
}
sleep 1;
}

Perl, How to break a loop with a signal handler sub

Let's say I have an opened filehandle, or anything I have to fix before to exit the script.
I also have a long loop and I want to break the loop if the processus receives a sigint. What is the cleanest way to do this?
Here is an illustration of the problem ;
use sigtrap 'handler' => \&sigint_handler, 'INT';
sub sigint_handler {
print("\nI see you are trying to escape this evil infinite loop,
but there is nothing that I can do to help you :(\n");
}
my $the_developper_is_unable_to_end_this_mess = 1;
open(my $handle, "< some.important.file");
while($the_developper_is_unable_to_end_this_mess) {
print("And the evil loop rolls again and again...\n");
sleep(3);
}
close($handle);
print("everything went better than expected\n")
Cleanup code that should absolutely be run can be put into an END block:
END {
print "This is run before the program exits\n";
}
print "This is some normal code\n";
Output:
This is some normal code
This is run before the program exits
However, END blocks are not run when the process terminates from a signal, unless when you implement your own signal handler – and if all that it does is calling exit.
So this code won't print END when you terminate it with a SIGINT:
END { print "END\n" }
sleep 4;
But this one will:
END { print "END\n" }
local $SIG{INT} = sub { exit 1 };
sleep 4;
These handlers are dynamically scoped, so you can put one into the loop that isn't in effect on the outside:
my $run = 1;
while ($run) {
local $SIG{INT} = sub { $run = 0 };
print "zzz\n";
sleep 3;
}
print "done!\n";
Of course you can also use sigtrap:
my $run = 1;
while ($run) {
use sigtrap handler => sub { $run = 0 }, 'INT';
print "zzz\n";
sleep 3;
}
print "done!\n";
PS: Filehandles are automatically closed when they fall out of scope / on process exit. If the handle is just reading from a file, there can't be any buffering issues or other processes depending on the handle, so that you can safely forget about close $fh in this case.

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.