File Coverage

blib/lib/JIP/Spy/Events.pm
Criterion Covered Total %
statement 87 92 94.5
branch 17 18 94.4
condition 4 4 100.0
subroutine 22 25 88.0
pod 6 11 54.5
total 136 150 90.6


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