line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Math::ModInt::Event::Trap; |
2
|
|
|
|
|
|
|
|
3
|
11
|
|
|
11
|
|
209
|
use 5.006; |
|
11
|
|
|
|
|
38
|
|
4
|
11
|
|
|
11
|
|
58
|
use strict; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
258
|
|
5
|
11
|
|
|
11
|
|
60
|
use warnings; |
|
11
|
|
|
|
|
30
|
|
|
11
|
|
|
|
|
309
|
|
6
|
11
|
|
|
11
|
|
67
|
use Carp qw(carp croak); |
|
11
|
|
|
|
|
27
|
|
|
11
|
|
|
|
|
1150
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# ----- class data ----- |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
BEGIN { |
11
|
11
|
|
|
11
|
|
63
|
our @CARP_NOT = qw(Math::ModInt::Event); |
12
|
11
|
|
|
|
|
377
|
our $VERSION = '0.013'; |
13
|
|
|
|
|
|
|
} |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Math::ModInt::Event::Trap=ARRAY(...) |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# ........... index ........... # ............ value ............ |
18
|
11
|
|
|
11
|
|
90
|
use constant F_TRAP_ID => 0; # instance ID, used as a weak ref |
|
11
|
|
|
|
|
31
|
|
|
11
|
|
|
|
|
1226
|
|
19
|
11
|
|
|
11
|
|
99
|
use constant NFIELDS => 1; |
|
11
|
|
|
|
|
21
|
|
|
11
|
|
|
|
|
606
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# ARRAY, element of @handlers: |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# ........... index ........... # ............ value ............ |
24
|
11
|
|
|
11
|
|
66
|
use constant H_TRAP_ID => 0; # instance ID of trap (0 if static) |
|
11
|
|
|
|
|
23
|
|
|
11
|
|
|
|
|
661
|
|
25
|
11
|
|
|
11
|
|
80
|
use constant H_EVENT => 1; # event to trap |
|
11
|
|
|
|
|
20
|
|
|
11
|
|
|
|
|
581
|
|
26
|
11
|
|
|
11
|
|
69
|
use constant H_HANDLER => 2; # the handler coderef |
|
11
|
|
|
|
|
27
|
|
|
11
|
|
|
|
|
7339
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $unique = 0; |
29
|
|
|
|
|
|
|
my @handlers = (); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my %generic_handlers = ( |
32
|
|
|
|
|
|
|
'ignore' => sub { 0 }, |
33
|
|
|
|
|
|
|
'warn' => |
34
|
|
|
|
|
|
|
sub { |
35
|
|
|
|
|
|
|
my ($event, @details) = @_; |
36
|
|
|
|
|
|
|
carp join q[: ], 'warning', $event->description, @details; |
37
|
|
|
|
|
|
|
return 0; |
38
|
|
|
|
|
|
|
}, |
39
|
|
|
|
|
|
|
'die' => |
40
|
|
|
|
|
|
|
sub { |
41
|
|
|
|
|
|
|
my ($event, @details) = @_; |
42
|
|
|
|
|
|
|
croak join q[: ], 'error', $event->description, @details; |
43
|
|
|
|
|
|
|
}, |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# ----- private subroutines ----- |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _discard_handler { |
49
|
12
|
|
|
12
|
|
20
|
my ($trap_id) = @_; |
50
|
12
|
|
|
|
|
22
|
my $hx = @handlers; |
51
|
12
|
|
|
|
|
29
|
while ($hx) { |
52
|
17
|
100
|
|
|
|
41
|
if ($trap_id == $handlers[--$hx]->[H_TRAP_ID]) { |
53
|
12
|
|
|
|
|
23
|
splice @handlers, $hx, 1; |
54
|
12
|
|
|
|
|
182
|
return; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub _add_handler { |
60
|
13
|
|
|
13
|
|
20
|
my ($trap_id, $event, $handler) = @_; |
61
|
13
|
|
|
|
|
31
|
push @handlers, [$trap_id, $event, $handler]; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _final_trap { |
65
|
36
|
|
|
36
|
|
74
|
my ($event, @details) = @_; |
66
|
36
|
|
|
|
|
99
|
croak join q[: ], $event->description, @details; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# ----- public methods ----- |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub new { |
72
|
15
|
|
|
15
|
1
|
27
|
my ($class, $event, $handler) = @_; |
73
|
15
|
|
|
|
|
21
|
my $is_static = !defined wantarray; |
74
|
15
|
100
|
|
|
|
33
|
my $trap_id = $is_static? 0: ++$unique; |
75
|
15
|
100
|
|
|
|
33
|
if (!ref $handler) { |
76
|
5
|
100
|
100
|
|
|
28
|
if (!$handler || !exists $generic_handlers{$handler}) { |
77
|
2
|
|
|
|
|
20
|
$event->UsageError->raise( |
78
|
|
|
|
|
|
|
'bad argument: generic trap type or coderef expected' |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
} |
81
|
3
|
|
|
|
|
6
|
$handler = $generic_handlers{$handler}; |
82
|
|
|
|
|
|
|
} |
83
|
13
|
|
|
|
|
32
|
_add_handler($trap_id, $event, $handler); |
84
|
13
|
100
|
|
|
|
28
|
return if $is_static; |
85
|
12
|
|
|
|
|
34
|
return bless [$trap_id], $class; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub DESTROY { |
89
|
12
|
|
|
12
|
|
2248
|
my ($this) = @_; |
90
|
12
|
|
|
|
|
34
|
_discard_handler($this->[F_TRAP_ID]); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub broadcast { |
94
|
114
|
|
|
114
|
1
|
243
|
my ($class, $event, @details) = @_; |
95
|
114
|
|
|
|
|
162
|
my $called = 0; |
96
|
114
|
|
|
|
|
260
|
foreach my $handler (reverse @handlers) { |
97
|
17
|
100
|
|
|
|
93
|
if ($event->isa(ref $handler->[H_EVENT])) { |
98
|
13
|
|
|
|
|
18
|
++$called; |
99
|
13
|
100
|
|
|
|
32
|
last if !$handler->[H_HANDLER]->($event, @details); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} |
102
|
110
|
100
|
|
|
|
308
|
if (!$event->is_recoverable) { |
103
|
36
|
|
|
|
|
115
|
_final_trap($event, @details); |
104
|
|
|
|
|
|
|
} |
105
|
74
|
|
|
|
|
159
|
return $called; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
1; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
__END__ |