File Coverage

lib/Fork/Utils.pm

Criterion	Covered	Total	%
statement	46	47	97.8
branch	7	14	50.0
condition	2	6	33.3
subroutine	7	7	100.0
pod	1	1	100.0
total	63	75	84.0

package Fork::Utils;

use 5.012;
use warnings;
use base qw/ Exporter /;
use Config ();
use POSIX ();
use Carp qw/ croak /;

our $VERSION = '0.01';
our @EXPORT_OK = qw/ safe_exec /;

sub safe_exec  {

    my ( %options ) = @_;
    my ( $code, $args, $sigset, $replace_mask ) = @options{ qw/code args sigset replace_mask/ };

    croak( 'Argument $code must be a CODE reference.' ) if ( ref( $code ) ne 'CODE' );
    croak( 'Argument $args must be an ARRAY reference.' ) if ( $args && ref( $args ) ne 'ARRAY' );
    croak( 'Argument $sigset must be an ARRAY reference.' ) if ( $sigset && ref( $sigset ) ne 'ARRAY' );

    state $sig_nums  = [ split( /\s+/, $Config::Config{'sig_num'} ) ];
    state $sig_names = [ split( /\s+/, $Config::Config{'sig_name'} ) ];
    my %signame2signum = ();

    for my $i ( 0 .. $#{$sig_nums} ) {
        $signame2signum{ $sig_names->[ $i ] } = $sig_nums->[ $i ];
    }

    my $new_sig_set = new POSIX::SigSet ();
    my $old_sig_set = new POSIX::SigSet ();

    $new_sig_set->emptyset();
    $old_sig_set->emptyset();

    $sigset = [] if ( ! $sigset ); # let's use empty mask by default

    foreach my $sig_name ( grep { $_ } @{ $sigset } ) {
        $new_sig_set->addset( $signame2signum{ $sig_name } ) if ( $signame2signum{ $sig_name } );
    }

    if ( ! $replace_mask ) { # add signals into the current mask
        POSIX::sigprocmask( POSIX::SIG_BLOCK, $new_sig_set, $old_sig_set );
    } else { # replace the current signla mask
        POSIX::sigprocmask( POSIX::SIG_SETMASK, $new_sig_set, $old_sig_set );
    }

    my $result = eval{ $code->( @{ $args || [] } ); };
    my $error = $@;

    # we don't use POSIX::SIG_UNBLOCK because we can occasionally unblock some signals that were blocked previously
    POSIX::sigprocmask( POSIX::SIG_SETMASK, $old_sig_set );

    $@ = $error; # restore the error if it was replaced by POSIX::sigprocmask

    return( $result );
}

1;
__END__