File Coverage

blib/lib/JIP/Spy/Events.pm
Criterion Covered Total %
statement 80 85 94.1
branch 13 14 92.8
condition 2 2 100.0
subroutine 21 24 87.5
pod 6 10 60.0
total 122 135 90.3


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