File Coverage

blib/lib/Signal/Mask.pm
Criterion Covered Total %
statement 44 62 70.9
branch 3 8 37.5
condition n/a
subroutine 14 20 70.0
pod n/a
total 61 90 67.7


line stmt bran cond sub pod time code
1             package Signal::Mask;
2             $Signal::Mask::VERSION = '0.009';
3 2     2   298441 use strict;
  2         3  
  2         83  
4 2     2   11 use warnings FATAL => 'all';
  2         3  
  2         152  
5              
6 2     2   12 use Config;
  2         4  
  2         104  
7 2     2   1177 use POSIX qw/SIG_BLOCK SIG_UNBLOCK SIG_SETMASK/;
  2         16725  
  2         11  
8             BEGIN {
9 2 50   2   3605 if (eval { require Thread::SigMask }) {
  2         1250  
10 2         1677 *sigmask = \&Thread::SigMask::sigmask;
11             }
12             else {
13 0         0 require POSIX;
14 0         0 *sigmask = \&POSIX::sigprocmask;
15             }
16             }
17 2     2   1252 use IPC::Signal qw/sig_num sig_name/;
  2         2121  
  2         176  
18 2     2   17 use Carp qw/croak/;
  2         4  
  2         154  
19              
20             my $sig_max = $Config{sig_count} - 1;
21              
22             {
23 2     2   20 no warnings 'once';
  2         6  
  2         2569  
24             tie %Signal::Mask, __PACKAGE__;
25             }
26              
27             sub TIEHASH {
28 2     2   6 my $class = shift;
29 2         7 my $self = { iterator => 1, };
30 2         8 return bless $self, $class;
31             }
32              
33             sub _get_status {
34 1     1   5 my ($self, $num) = @_;
35 1         4 my $mask = POSIX::SigSet->new;
36 1         8 sigmask(SIG_BLOCK, POSIX::SigSet->new(), $mask);
37 1         9 return $mask->ismember($num);
38             }
39              
40             sub FETCH {
41 1     1   432 my ($self, $key) = @_;
42 1         3 return $self->_get_status(sig_num($key));
43             }
44              
45             my $block_signal = sub {
46             my ($self, $key) = @_;
47             my $num = sig_num($key);
48             croak "No such signal '$key'" if not defined $num;
49             sigmask(SIG_BLOCK, POSIX::SigSet->new($num)) or croak "Couldn't block signal: $!";
50             return;
51             };
52              
53             my $unblock_signal = sub {
54             my ($self, $key) = @_;
55             my $num = sig_num($key);
56             croak "No such signal '$key'" if not defined $num;
57             my $ret = POSIX::SigSet->new($num);
58             sigmask(SIG_UNBLOCK, POSIX::SigSet->new($num), $ret) or croak "Couldn't unblock signal: $!";
59             return $ret->ismember($num);
60             };
61              
62             sub STORE {
63 2     2   819 my ($self, $key, $value) = @_;
64 2 100       7 my $method = $value ? $block_signal : $unblock_signal;
65 2         7 $self->$method($key);
66 2         9 return;
67             }
68              
69             sub DELETE {
70 0     0   0 my ($self, $key) = @_;
71 0         0 return $self->$unblock_signal($key);
72             }
73              
74             sub CLEAR {
75 0     0   0 my ($self) = @_;
76 0         0 sigmask(SIG_SETMASK, POSIX::SigSet->new());
77 0         0 return;
78             }
79              
80             sub EXISTS {
81 1     1   4 my ($self, $key) = @_;
82 1         13 return defined sig_num($key);
83             }
84              
85             sub FIRSTKEY {
86 0     0   0 my $self = shift;
87 0         0 $self->{iterator} = 1;
88 0         0 return $self->NEXTKEY;
89             }
90              
91             sub NEXTKEY {
92 0     0   0 my $self = shift;
93 0 0       0 if ($self->{iterator} <= $sig_max) {
94 0         0 my $num = $self->{iterator}++;
95 0 0       0 return wantarray ? (sig_name($num) => $self->_get_status($num)) : sig_name($num);
96             }
97             else {
98 0         0 return;
99             }
100             }
101              
102             sub SCALAR {
103 2     2   251041 my $self = shift;
104 2         33 my $mask = POSIX::SigSet->new;
105 2         19 sigmask(SIG_BLOCK, POSIX::SigSet->new(), $mask);
106 2         14 return scalar grep { $mask->ismember($_) } 1 .. $sig_max;
  128         259  
107             }
108              
109             sub UNTIE {
110 0     0     my $self = shift;
111 0           $self->CLEAR;
112 0           return;
113             }
114              
115       0     sub DESTROY {
116             }
117              
118             1; # End of Signal::Mask
119              
120             # ABSTRACT: Signal masks made easy
121              
122             __END__