line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Stem::Event::Signal ; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
2046
|
use Stem::Event::Queue ; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
514
|
|
4
|
|
|
|
|
|
|
|
5
|
4
|
|
|
4
|
|
25
|
use strict ; |
|
4
|
|
|
|
|
34
|
|
|
4
|
|
|
|
|
120
|
|
6
|
4
|
|
|
4
|
|
19
|
use warnings ; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
115
|
|
7
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
23
|
use base 'Exporter' ; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
322
|
|
9
|
|
|
|
|
|
|
our @EXPORT = qw( process_signal_queue ) ; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# this generic signal event code needs the safe signals of perl 5.8+ |
12
|
|
|
|
|
|
|
|
13
|
4
|
|
|
4
|
|
98
|
use 5.008 ; |
|
4
|
|
|
|
|
22
|
|
|
4
|
|
|
|
|
1412
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my %signal2event ; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my @signal_queue ; |
18
|
|
|
|
|
|
|
my %cached_handlers ; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# this sub will cache the handler closures so we can reuse them. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub _build { |
23
|
|
|
|
|
|
|
|
24
|
0
|
|
|
0
|
|
|
my( $self ) = @_ ; |
25
|
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
|
my $signal = $self->{'signal'} ; |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
0
|
|
|
|
$self->{'method'} ||= "sig_\L${signal}_handler" ; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# create the signal event handler and cache it. |
31
|
|
|
|
|
|
|
# we cache them so we can reuse these closures and never leak |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
$SIG{ $signal } = $cached_handlers{$signal} ||= |
34
|
|
|
|
|
|
|
sub { |
35
|
0
|
|
|
0
|
|
|
mark_not_empty() ; |
36
|
|
|
|
|
|
|
#print "HIT $signal\n"; |
37
|
0
|
|
|
|
|
|
push @signal_queue, $signal |
38
|
0
|
|
0
|
|
|
|
} ; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# track the event object for this signal |
41
|
|
|
|
|
|
|
|
42
|
0
|
|
|
|
|
|
$signal2event{$signal} = $self ; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
#print "$signal = $SIG{ $signal }\n" ; |
45
|
0
|
|
|
|
|
|
return ; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _cancel { |
49
|
|
|
|
|
|
|
|
50
|
0
|
|
|
0
|
|
|
my( $self ) = @_ ; |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
$SIG{ $self->{'signal'} } = 'DEFAULT' ; |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
return ; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub process_signal_queue { |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
0
|
0
|
|
my $sig_count = @signal_queue ; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
#print "PROCESS SIGNAL Q $sig_count\n" ; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# return if we have no pending signals |
64
|
|
|
|
|
|
|
|
65
|
0
|
0
|
|
|
|
|
return $sig_count unless $sig_count ; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
while( my $signal = shift @signal_queue ) { |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
my $event = $signal2event{ $signal } ; |
70
|
|
|
|
|
|
|
|
71
|
0
|
0
|
|
|
|
|
next unless $event ; |
72
|
0
|
0
|
|
|
|
|
next unless $event->{'active'} ; |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
$event->trigger() ; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
return $sig_count ; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
1 ; |