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


line stmt bran cond sub pod time code
1             package Sys::Signals::Block;
2             $Sys::Signals::Block::VERSION = '0.11';
3             # ABSTRACT: Simple interface to block delivery of signals
4              
5 5     5   12900 use 5.008;
  5         29  
6 5     5   21 use strict;
  5         6  
  5         90  
7 5     5   17 use warnings;
  5         8  
  5         142  
8              
9 5     5   2127 use Moo;
  5         60918  
  5         22  
10 5     5   8280 use MooX::ClassAttribute;
  5         83982  
  5         28  
11 5     5   2500 use strictures 2;
  5         6363  
  5         201  
12 5     5   796 use Carp qw(croak);
  5         11  
  5         301  
13 5     5   1180 use POSIX qw(sigprocmask SIG_BLOCK SIG_UNBLOCK);
  5         14182  
  5         32  
14 5     5   8126 use namespace::clean;
  5         46459  
  5         31  
15              
16             # maps signal names to signal numbers
17             class_has signal_numbers => (is => 'lazy');
18              
19              
20             has sigset => (is => 'rw');
21              
22              
23             has is_blocked => (is => 'rw', default => sub { 0 });
24              
25             sub import {
26 8     8   1365 my $class = shift;
27              
28 8 100       79 if (@_) {
29 4         9 my $instance = $class->instance;
30              
31 4 50       11 my $sigset = $instance->_parse_signals(@_)
32             or croak "no valid signals listed on import line";
33              
34 4         44 $instance->sigset($sigset);
35             }
36             }
37              
38              
39             around BUILDARGS => sub {
40             my ($orig, $class, @args) = @_;
41              
42             if (@args and !ref $args[0]) {
43             my $sigset = $class->_parse_signals(@args)
44             or croak "No valid signals given to constructor\n";
45              
46             return $class->$orig({sigset => $sigset});
47             }
48             else {
49             return $class->$orig(@args);
50             }
51             };
52              
53              
54             my $Instance;
55              
56             sub instance {
57 7     7 1 484 my $class = shift;
58              
59 7 100       21 unless ( defined $Instance ) {
60 2         10 $Instance = $class->new;
61             }
62              
63 7         17 return $Instance;
64             }
65              
66              
67             sub block {
68 3     3 1 3907 my $self = __self_or_instance(@_);
69              
70 3 50       20 return if $self->is_blocked;
71              
72 3         36 my $retval = sigprocmask(SIG_BLOCK, $self->sigset);
73              
74 3 50       11 if ($retval) {
75 3         11 $self->is_blocked(1);
76             }
77              
78 3         9 return $retval;
79             }
80              
81              
82             sub unblock {
83 3     3 1 2003415 my $self = __self_or_instance(@_);
84              
85 3 50       17 return unless $self->is_blocked;
86              
87 3         69 my $retval = sigprocmask(SIG_UNBLOCK, $self->sigset);
88              
89 3 50       48 if ($retval) {
90 3         59 $self->is_blocked(0);
91             }
92              
93 3         8 return $retval;
94             }
95              
96             # parse a list of signal names and return a POSIX::SigSet object representing
97             # the set of signals. Return nothing if no valid signals were parsed. Will
98             # croak if an invalid signal name is given.
99             sub _parse_signals {
100 6     6   18 my ($class, @signals) = @_;
101              
102 6         8 my @nums;
103              
104 6         12 for my $signal (@signals) {
105 12 100       45 unless ($signal =~ /\D/) {
106 2         3 push @nums, $signal;
107             }
108             else {
109 10         27 $signal =~ s/^SIG//;
110              
111 10         169 my $num = $class->signal_numbers->{$signal};
112              
113 10 50       54 unless (defined $num) {
114 0         0 croak "invalid signal name: 'SIG${signal}'";
115             }
116              
117 10         25 push @nums, $num;
118             }
119             }
120              
121             # no valid signals, just return.
122 6 50       15 unless (@nums) {
123 0         0 return;
124             }
125              
126 6         80 return POSIX::SigSet->new(@nums);
127             }
128              
129             sub _build_signal_numbers {
130 4     4   34 my $self = shift;
131              
132 4         23 require Config;
133              
134 4         383 my @names = split /\s+/, $Config::Config{sig_name};
135 4         294 my @nums = split /[\s,]+/, $Config::Config{sig_num};
136              
137 4         16 my %sigs;
138              
139 4         168 @sigs{@names} = @nums;
140              
141 4         48 return \%sigs;
142             }
143              
144             sub __self_or_instance {
145 6     6   15 my $self = shift;
146              
147 6 100       23 unless (ref $self) {
148 2         7 $self = $self->instance;
149             }
150              
151 6         16 return $self;
152             }
153              
154             1;
155              
156             __END__