File Coverage

blib/lib/IO/Async/Signal.pm
Criterion Covered Total %
statement 38 40 95.0
branch 7 10 70.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 2 2 100.0
total 57 64 89.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009-2024 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Signal 0.805;
7              
8 2     2   244208 use v5.14;
  2         11  
9 2     2   14 use warnings;
  2         4  
  2         181  
10 2     2   21 use base qw( IO::Async::Notifier );
  2         5  
  2         1343  
11              
12 2     2   17 use Carp;
  2         5  
  2         1280  
13              
14             =head1 NAME
15              
16             C - event callback on receipt of a POSIX signal
17              
18             =head1 SYNOPSIS
19              
20             =for highlighter language=perl
21              
22             use IO::Async::Signal;
23              
24             use IO::Async::Loop;
25             my $loop = IO::Async::Loop->new;
26              
27             my $signal = IO::Async::Signal->new(
28             name => "HUP",
29              
30             on_receipt => sub {
31             print "I caught SIGHUP\n";
32             },
33             );
34              
35             $loop->add( $signal );
36              
37             $loop->run;
38              
39             =head1 DESCRIPTION
40              
41             This subclass of L invokes its callback when a particular
42             POSIX signal is received.
43              
44             Multiple objects can be added to a C that all watch for the same signal.
45             The callback functions will all be invoked, in no particular order.
46              
47             =cut
48              
49             =head1 EVENTS
50              
51             The following events are invoked, either using subclass methods or CODE
52             references in parameters:
53              
54             =head2 on_receipt
55              
56             Invoked when the signal is received.
57              
58             =cut
59              
60             =head1 PARAMETERS
61              
62             The following named parameters may be passed to C or C:
63              
64             =head2 name => STRING
65              
66             The name of the signal to watch. This should be a bare name like C. Can
67             only be given at construction time.
68              
69             =head2 on_receipt => CODE
70              
71             CODE reference for the C event.
72              
73             Once constructed, the C will need to be added to the C before it
74             will work.
75              
76             =cut
77              
78             sub _init
79             {
80 4     4   10 my $self = shift;
81 4         9 my ( $params ) = @_;
82              
83 4 50       21 my $name = delete $params->{name} or croak "Expected 'name'";
84              
85 4         14 $name =~ s/^SIG//; # Trim a leading "SIG"
86              
87 4         16 $self->{name} = $name;
88              
89 4         19 $self->SUPER::_init( $params );
90             }
91              
92             sub configure
93             {
94 5     5 1 1182 my $self = shift;
95 5         16 my %params = @_;
96              
97 5 100       23 if( exists $params{on_receipt} ) {
98 4         11 $self->{on_receipt} = delete $params{on_receipt};
99              
100 4         11 undef $self->{cb}; # Will be lazily constructed when needed
101              
102 4 100       17 if( my $loop = $self->loop ) {
103 1         5 $self->_remove_from_loop( $loop );
104 1         4 $self->_add_to_loop( $loop );
105             }
106             }
107              
108 5 50       25 unless( $self->can_event( 'on_receipt' ) ) {
109 0         0 croak 'Expected either a on_receipt callback or an ->on_receipt method';
110             }
111              
112 5         21 $self->SUPER::configure( %params );
113             }
114              
115             sub _add_to_loop
116             {
117 5     5   10 my $self = shift;
118 5         14 my ( $loop ) = @_;
119              
120 5   33     40 $self->{cb} ||= $self->make_event_cb( 'on_receipt' );
121              
122 5         31 $self->{id} = $loop->attach_signal( $self->{name}, $self->{cb} );
123             }
124              
125             sub _remove_from_loop
126             {
127 3     3   5 my $self = shift;
128 3         7 my ( $loop ) = @_;
129              
130 3         21 $loop->detach_signal( $self->{name}, $self->{id} );
131 3         16 undef $self->{id};
132             }
133              
134             sub notifier_name
135             {
136 1     1 1 8081 my $self = shift;
137 1 50       11 if( length( my $name = $self->SUPER::notifier_name ) ) {
138 0         0 return $name;
139             }
140              
141 1         10 return $self->{name};
142             }
143              
144             =head1 AUTHOR
145              
146             Paul Evans
147              
148             =cut
149              
150             0x55AA;