File Coverage

blib/lib/Math/ModInt/Event/Trap.pm
Criterion Covered Total %
statement 59 59 100.0
branch 16 16 100.0
condition 3 3 100.0
subroutine 16 16 100.0
pod 2 2 100.0
total 96 96 100.0


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__