This is just to document (and place in google) how to do unsafe signals in recent perls without loading a non-core library to do it:
use POSIX qw(SIGALRM);
my $timeout = 30;
my $sigset = POSIX::SigSet->new(SIGALRM);
my $action = POSIX::SigAction->new(
sub {
# re-install alarm in case we were in an internal eval{} block
alarm($timeout);
die "timeout working on: " . (caller(1))[1] . "\n";
},
$sigset,
&POSIX::SA_NODEFER, # turns off safe signals
);
POSIX::sigaction(SIGALRM, $action);
my $prev_alarm = alarm($timeout);
eval {
# long running code here
};
my $err = $@;
alarm($prev_alarm);
if ($err) {
if ($err !~/timeout working on:/) {
die $err; # propogate this error
}
# process the timeout
}
This is written for alarms, which TBH is probably where you really need it, since the regexp engine can get its knickers in a twist and not fire your alarm until the heat death of the universe, but the code will work for other types of signals too.
And yes, I know there are modules on CPAN for this, such as the excellent and very simple Perl::Unsafe::Signals, but sometimes another module isn't an option. I also know the code is a bit flawed in that the second installation of the alarm doesn't do the right thing (it should install at as $timeout - (time - $start_time)), so feel free to fix it yourself.
Perl Unsafe Signals 0 Comments More | Login | Reply /