File Coverage

blib/lib/Sys/Signals/Block.pm

Criterion	Covered	Total	%
statement	69	71	97.1
branch	15	22	68.1
condition			n/a
subroutine	16	16	100.0
pod	3	3	100.0
total	103	112	91.9

package Sys::Signals::Block;
$Sys::Signals::Block::VERSION = '0.11';
# ABSTRACT: Simple interface to block delivery of signals

use 5.008;
use strict;
use warnings;

use Moo;
use MooX::ClassAttribute;
use strictures 2;
use Carp qw(croak);
use POSIX qw(sigprocmask SIG_BLOCK SIG_UNBLOCK);
use namespace::clean;

# maps signal names to signal numbers
class_has signal_numbers => (is => 'lazy');


has sigset => (is => 'rw');


has is_blocked => (is => 'rw', default => sub { 0 });

sub import {
    my $class = shift;

    if (@_) {
        my $instance = $class->instance;

        my $sigset = $instance->_parse_signals(@_)
            or croak "no valid signals listed on import line";

        $instance->sigset($sigset);
    }
}


around BUILDARGS => sub {
    my ($orig, $class, @args) = @_;

    if (@args and !ref $args[0]) {
        my $sigset = $class->_parse_signals(@args)
            or croak "No valid signals given to constructor\n";

        return $class->$orig({sigset => $sigset});
    }
    else {
        return $class->$orig(@args);
    }
};


my $Instance;

sub instance {
    my $class = shift;

    unless ( defined $Instance ) {
        $Instance = $class->new;
    }

    return $Instance;
}


sub block {
    my $self = __self_or_instance(@_);

    return if $self->is_blocked;

    my $retval = sigprocmask(SIG_BLOCK, $self->sigset);

    if ($retval) {
        $self->is_blocked(1);
    }

    return $retval;
}


sub unblock {
    my $self = __self_or_instance(@_);

    return unless $self->is_blocked;

    my $retval = sigprocmask(SIG_UNBLOCK, $self->sigset);

    if ($retval) {
        $self->is_blocked(0);
    }

    return $retval;
}

# parse a list of signal names and return a POSIX::SigSet object representing
# the set of signals.  Return nothing if no valid signals were parsed.  Will
# croak if an invalid signal name is given.
sub _parse_signals {
    my ($class, @signals) = @_;

    my @nums;

    for my $signal (@signals) {
        unless ($signal =~ /\D/) {
            push @nums, $signal;
        }
        else {
            $signal =~ s/^SIG//;

            my $num = $class->signal_numbers->{$signal};

            unless (defined $num) {
                croak "invalid signal name: 'SIG${signal}'";
            }

            push @nums, $num;
        }
    }

    # no valid signals, just return.
    unless (@nums) {
        return;
    }

    return POSIX::SigSet->new(@nums);
}

sub _build_signal_numbers {
    my $self = shift;

    require Config;

    my @names = split /\s+/, $Config::Config{sig_name};
    my @nums  = split /[\s,]+/, $Config::Config{sig_num};

    my %sigs;

    @sigs{@names} = @nums;

    return \%sigs;
}

sub __self_or_instance {
    my $self = shift;

    unless (ref $self) {
        $self = $self->instance;
    }

    return $self;
}

1;

__END__