On Sat, 2004-01-10 at 05:18, Tim Bunce wrote:
[snip]
>
> > I will share the solution when I have it figured out. In fact, would be
> > willing to give you a README.signals file to include in DBI docs if I
> > get it figured out.
>
> If you figure it all out I'll not only add your write up to the
> DBI.pm pod, I'll use it as the basis for the relevant part of the
> 2nd edition of the DBI book :-) Your name will be in lights!
OK, I got it. And I _will_ write it up. But in the meantime, I have a
little module, I have written to solve this problem in a way that works
for 5.6.x and 5.8.x transparently. I'm thinking of
putting up CPAN... I will send a message to module-authors after this
message. Currently (for convenience I am calling this SignalHandler.pm
(attached). (Gotta come up with a name). It includes the beginning of
POD, which demonstates how to use set_handler() with it defines.
This module and documentation is incomplete at the moment, but
set_handler() will work with DBI->connect(), and do the right thing (on
both linux and solaris). I tested it with the DBD-Oracle driver, which
was hanging for me on a connect to a database on a box that is down.
I can think of no reason why it would not work for any driver (or any
code for that matter) that suffers from this problem. I will test it on
HPUX next week.
I'm 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. But this solves the problem raised by this thread, and which
has prevented me from upgrading to perl 5.8 at Fleet for the last 9
months. I still need to test for the availability of sigaction() with
%Config, (and perhaps), provide a signal() based implementation if
sigaction() is not found.
I hope this helps.
Lincoln
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;
