File Coverage

blib/lib/JIP/Spy/Events.pm
Criterion Covered Total %
statement 94 99 94.9
branch 21 22 95.4
condition 4 4 100.0
subroutine 24 27 88.8
pod 8 13 61.5
total 151 165 91.5


line stmt bran cond sub pod time code
1             package JIP::Spy::Events;
2              
3 1     1   74383 use strict;
  1         12  
  1         29  
4 1     1   5 use warnings;
  1         9  
  1         32  
5 1     1   501 use version 0.77;
  1         2015  
  1         7  
6              
7 1     1   73 use Carp qw(croak);
  1         5  
  1         53  
8 1     1   6 use Scalar::Util qw(blessed reftype);
  1         1  
  1         49  
9 1     1   5 use English qw(-no_match_vars);
  1         2  
  1         5  
10              
11 1     1   798 use JIP::Spy::Event;
  1         3  
  1         571  
12              
13             our $VERSION = version->declare('v0.0.5');
14             our $AUTOLOAD;
15              
16             sub new {
17 9     9 1 24465 my ( $class, %param ) = @ARG;
18              
19 9         36 my $state = {
20             on_spy_event => {},
21             events => [],
22             times => {},
23             skip_methods => {},
24             want_array => 0,
25             };
26              
27 9 100       41 if ( $param{want_array} ) {
28 1         3 $state->{want_array} = 1;
29             }
30              
31 9 100       46 if ( my $skip_methods = $param{skip_methods} ) {
32 1         2 foreach my $method_name ( @{$skip_methods} ) {
  1         2  
33 1         3 $state->{skip_methods}->{$method_name} = undef;
34             }
35             }
36              
37 9         30 return bless $state, $class;
38             } ## end sub new
39              
40             sub events {
41 27     27 1 1050 my ($self) = @ARG;
42              
43 27         141 return $self->{events};
44             }
45              
46             sub times {
47 44     44 1 82 my ($self) = @ARG;
48              
49 44         155 return $self->{times};
50             }
51              
52             sub want_array {
53 15     15 1 29 my ($self) = @ARG;
54              
55 15         35 return $self->{want_array};
56             }
57              
58             sub skip_methods {
59 15     15 0 28 my ($self) = @ARG;
60              
61 15         53 return $self->{skip_methods};
62             }
63              
64             sub clear {
65 2     2 1 4 my ($self) = @ARG;
66              
67 2         3 @{ $self->events() } = ();
  2         6  
68 2         3 %{ $self->times() } = ();
  2         5  
69              
70 2         4 return $self;
71             }
72              
73             sub on_spy_event {
74 16     16 1 34 my ( $self, %declarations ) = @ARG;
75              
76 16 100       33 if (%declarations) {
77 2         8 $self->{on_spy_event} = \%declarations;
78             }
79              
80 16         45 return $self->{on_spy_event};
81             }
82              
83             sub called {
84 4     4 1 12 my ($self) = @ARG;
85              
86 4 100       6 return 1 if keys %{ $self->times() };
  4         18  
87 2         16 return 0;
88             }
89              
90             sub not_called {
91 2     2 1 9 my ($self) = @ARG;
92              
93 2 100       4 return 1 if !$self->called();
94 1         4 return 0;
95             }
96              
97             sub AUTOLOAD {
98 14     14   4728 my ( $self, @arguments ) = @ARG;
99              
100 14 100       55 if ( !blessed $self ) {
101 1         218 croak q{Can't call "AUTOLOAD" as a class method};
102             }
103              
104 13         94 my ($method_name) = $AUTOLOAD =~ m{^ .+ :: ([^:]+) $}x;
105              
106 13         28 undef $AUTOLOAD;
107              
108 13         44 return $self->_handle_event(
109             method_name => $method_name,
110             arguments => \@arguments,
111             want_array => wantarray,
112             );
113             }
114              
115             sub isa {
116 1     1   15 no warnings 'misc';
  1         3  
  1         95  
117 1     1 0 421 goto &UNIVERSAL::isa;
118             }
119              
120             sub can {
121 9     9 0 620 my ( $self, $method_name ) = @ARG;
122              
123 9 50       34 if ( blessed $self ) {
124 1     1   7 no warnings 'misc';
  1         2  
  1         66  
125 9         70 goto &UNIVERSAL::can;
126             }
127             else {
128 0         0 my $code;
129 1     1   6 no warnings 'misc';
  1         2  
  1         105  
130 0         0 $code = UNIVERSAL::can( $self, $method_name );
131              
132 0         0 return $code;
133             }
134             }
135              
136             sub DOES {
137             # DOES is equivalent to isa by default
138 0     0 0 0 goto &isa;
139             }
140              
141             sub VERSION {
142 1     1   7 no warnings 'misc';
  1         2  
  1         321  
143 0     0 0 0 goto &UNIVERSAL::VERSION;
144             }
145              
146       0     sub DESTROY { }
147              
148             sub _handle_event {
149 14     14   50 my ( $self, %param ) = @ARG;
150              
151 14 100       33 return $self if exists $self->skip_methods()->{ $param{method_name} };
152              
153             {
154 13         26 my %event = (
155             method => $param{method_name},
156             arguments => $param{arguments},
157 13         39 );
158              
159 13 100       33 if ( $self->want_array() ) {
160 3         6 $event{want_array} = $param{want_array};
161             }
162              
163 13         23 push @{ $self->events() }, \%event;
  13         21  
164             }
165              
166 13   100     24 my $times = $self->times()->{ $param{method_name} } // 0;
167 13         19 $times += 1;
168 13         25 $self->times()->{ $param{method_name} } = $times;
169              
170 13         22 my $on_spy_event = $self->on_spy_event()->{ $param{method_name} };
171              
172 13 100       62 return $self if !$on_spy_event;
173              
174 2 100 100     11 if ( ( reftype($on_spy_event) || q{} ) ne 'CODE' ) {
175             croak sprintf(
176             q{"%s" is not a callback},
177             $param{method_name},
178 1         74 );
179             }
180              
181             my $event = JIP::Spy::Event->new(
182             method => $param{method_name},
183             arguments => $param{arguments},
184             want_array => $param{want_array},
185 1         14 times => $times,
186             );
187              
188 1         3 return $on_spy_event->( $self, $event );
189             } ## end sub _handle_event
190              
191             1;
192              
193             __END__