Hi,
A co-worker and I recently figured out a problem with the differences in
signal handling in between perl 5.6.x and perl 5.8.x, that has plagued
us for about 9 months, but which I did not have time to resolve sooner.
The problem is that code which looks like this:
my $alarm = 0;
eval {
local $SIG{ALRM} = sub { $alarm=1 };
alarm(3);
$dbh = DBI->connect( "dbi:Oracle:$dbn", $usr, $pwd
,{ AutoCommit=>$self->auto_commit()
,RaiseError=>1
,PrintError=>$self->print_err()
} );
alarm(0);
};
alarm(0);
if ($@)....
if ( $alarm ).... etc
Does not work the same way in perl 5.6.x and 5.8.x.
This is because 5.8.x introduced the use of the SA_RESTART flag
in the call to the underlying sigaction() function. In the above
example, the DBI->connect() through the oracle libraries eventually
call's the connect() system call. In perl 5.8.x this hangs for
a VERY long time if the system which hosts the database is down. The
signal handler is called, but connect() function is restarted.
I have written a module the uses POSIX:sigaction() directly as
suggested in the perlvar man page. (Note that code in the the perlvar
page does not work!). The working name of this module is currently
SignalHandler. This module is almost as convenient to use as the above:
#timeout a system call:
use POSIX ':signal_h' ;
use SignalHandler qw( set_handler );
eval {
local $SIG{ALRM};
set_handler( 'mypackage::mysubname' ,SIGALRM );
alarm(2)
#... do something you want to timeout for instance:
$dbh = DBI->connect( "dbi:Oracle:$dbn", $usr, $pwd
,{ AutoCommit=>$self->auto_commit()
,RaiseError=>1
,PrintError=>$self->print_err()
} );
alarm(0);
};
#perl clears the handler here... because of the local dec above
alarm(0);
if ( $@ ) ...
So, I have two questions:
1) Does anyone think such a module would be of general interest?
2) What would a good (Name/Namespace) for this module?
Module source follows. Note that it is still in a proof stage and would
be much more thoroughly documented before up load.
I'm also thinking of adding a timeout() function which would take a sub
ref and a timeout value, and execute the sub with a SIGALRM timeout
wrapped around it. I still need to test for the availability of
sigaction() with %Config (although I could do that in the Makefile.PL),
(and perhaps), provide a signal() based implementation if sigaction() is
not found.
################ code begins here ##############
package SignalHandler;
=head1 NAME
SignalHandler
=head1 SYNOPSYS
use POSIX ':signal_h' ;
use SignalHandler qw( set_handler reset_action );
my $oldaction = set_handler( 'mypackage::mysubname' ,SIGINT );
... do stuff non-interupt able
reset_action( $oldaction ,SIGINT );
or
#timeout a system call:
use POSIX ':signal_h' ;
use SignalHandler qw( set_handler );
eval {
local $SIG{ALRM};
set_handler( 'mypackage::mysubname' ,SIGALRM );
alarm(2)
... do something you want to timeout
alarm(0);
};
#perl clears the handler here...
alarm(0);
if ( $@ ) ...
or
use POSIX ':signal_h' ;
use SignalHandler qw( set_handler reset_action );
my $oldaction;
eval {
$oldaction = set_handler( 'mypackage::mysubname' ,SIGALRM );
alarm(2)
... do something you want to timeout
alarm(0);
};
alarm(0);
reset_action( $oldaction ,SIGALRM );
if ( $@ ) ...
=head1 DESCRIPTION
TODO...
=cut
use strict;
use warnings;
use POSIX ':signal_h' ;
require Exporter;
our ( @ISA ,@EXPORT_OK );
@ISA = qw( Exporter );
@EXPORT_OK = qw( set_handler set_action reset_action sigset sigact );
sub set_handler( $$ )
{
my ( $handler ,$sig ,$flags ) = @_;
my $sigset = sigset( $sig );
my $act = sigact( $handler ,$sig ,$flags );
return set_action( $act ,$sig );
}
sub set_action($$)
{
my ( $action ,$sig ) = @_;
my $oact = POSIX::SigAction->new();
sigaction( $sig ,$action ,$oact );
return $oact;
}
sub reset_action( $$ )
{
my ( $oldaction ,$sig ) = @_;
sigaction( $sig ,$oldaction );
}
sub sigset
{
my $sig = shift @_;
return $sig if UNIVERSAL::isa( $sig ,'POSIX::SigSet' );
return POSIX::SigSet->new( $sig );
}
sub sigact($$;$)
{
my ( $handler ,$sigset ,$flags ) = @_;
my $sact = POSIX::SigAction->new( $handler ,$sigset ,$flags );
}
1;
