File: | blib/lib/Test/Mocha/SpyBase.pm |
Coverage: | 94.4% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Test::Mocha::SpyBase; | ||||||
2 | # ABSTRACT: Abstract base class for Spy and Mock | ||||||
3 | $Test::Mocha::SpyBase::VERSION = '0.61'; | ||||||
4 | 12 12 12 | 3999 11 219 | use strict; | ||||
5 | 12 12 12 | 25 7 186 | use warnings; | ||||
6 | |||||||
7 | 12 12 12 | 25 144 355 | use Carp 1.22 'croak'; | ||||
8 | 12 12 12 | 3882 286975 54 | use Types::Standard qw( ArrayRef HashRef ); | ||||
9 | |||||||
10 | # class attributes | ||||||
11 | ## no critic (NamingConventions::Capitalization) | ||||||
12 | our $CaptureMode = 0; | ||||||
13 | my $NumMethodCalls = 0; | ||||||
14 | my $LastMethodCall; | ||||||
15 | |||||||
16 | sub CaptureMode { | ||||||
17 | 273 | 0 | 152 | my ( $class, $value ) = @_; | |||
18 | 273 | 400 | return $CaptureMode; | ||||
19 | } | ||||||
20 | |||||||
21 | sub NumMethodCalls { | ||||||
22 | 262 | 0 | 147 | my ( $class, $value ) = @_; | |||
23 | |||||||
24 | 262 | 251 | if ( defined $value ) { | ||||
25 | 131 | 80 | $NumMethodCalls = $value; | ||||
26 | } | ||||||
27 | 262 | 244 | return $NumMethodCalls; | ||||
28 | } | ||||||
29 | |||||||
30 | sub LastMethodCall { | ||||||
31 | 131 | 0 | 80 | my ( $class, $value ) = @_; | |||
32 | |||||||
33 | 131 | 133 | if ( defined $value ) { | ||||
34 | 131 | 84 | $LastMethodCall = $value; | ||||
35 | } | ||||||
36 | 131 | 113 | return $LastMethodCall; | ||||
37 | } | ||||||
38 | ## use critic | ||||||
39 | |||||||
40 | sub __new { | ||||||
41 | # uncoverable pod | ||||||
42 | 34 | 84 | my %args = ( | ||||
43 | calls => [], # ArrayRef[ MethodCall ] | ||||||
44 | stubs => {}, # $method_name => ArrayRef[ MethodStub ] | ||||||
45 | ); | ||||||
46 | 34 | 56 | return \%args; | ||||
47 | } | ||||||
48 | |||||||
49 | sub __calls { | ||||||
50 | 244 | 323 | my ($self) = @_; | ||||
51 | 244 | 333 | return $self->{calls}; | ||||
52 | } | ||||||
53 | |||||||
54 | sub __stubs { | ||||||
55 | 183 | 106 | my ($self) = @_; | ||||
56 | 183 | 173 | return $self->{stubs}; | ||||
57 | } | ||||||
58 | |||||||
59 | sub __find_stub { | ||||||
60 | # """ | ||||||
61 | # Returns the first stub that satisfies the given method call. | ||||||
62 | # Returns undef if no stub is found. | ||||||
63 | # """ | ||||||
64 | # uncoverable pod | ||||||
65 | 141 | 84 | my ( $self, $method_call ) = @_; | ||||
66 | 141 | 164 | my $stubs = $self->__stubs; | ||||
67 | |||||||
68 | 141 | 209 | return if !defined $stubs->{ $method_call->name }; | ||||
69 | |||||||
70 | 62 62 | 48 72 | foreach my $stub ( @{ $stubs->{ $method_call->name } } ) { | ||||
71 | 68 | 95 | return $stub if $stub->__satisfied_by($method_call); | ||||
72 | } | ||||||
73 | 3 | 6 | return; | ||||
74 | } | ||||||
75 | |||||||
76 | sub __capture_method_call { | ||||||
77 | # """ | ||||||
78 | # Get the last method called on a mock object, | ||||||
79 | # removes it from the invocation history, | ||||||
80 | # and restores the last method stub response. | ||||||
81 | # """ | ||||||
82 | # uncoverable pod | ||||||
83 | 140 | 105 | my ( $class, $coderef ) = @_; | ||||
84 | |||||||
85 | ### assert: !$CaptureMode | ||||||
86 | 140 | 81 | $NumMethodCalls = 0; | ||||
87 | 140 | 105 | $LastMethodCall = undef; | ||||
88 | { | ||||||
89 | # Execute the coderef. This should in turn include a method call on | ||||||
90 | # mock, which should be handled by its AUTOLOAD method. | ||||||
91 | ## no critic (Variables::ProhibitLocalVars) | ||||||
92 | 140 140 | 415 280 | local $CaptureMode = 1; | ||||
93 | 140 | 195 | $coderef->(); | ||||
94 | } | ||||||
95 | |||||||
96 | 131 | 242 | croak 'Coderef must have a method invoked on a mock object' | ||||
97 | if $NumMethodCalls == 0; | ||||||
98 | 130 | 211 | croak 'Coderef must not have multiple methods invoked on a mock object' | ||||
99 | if $NumMethodCalls > 1; | ||||||
100 | |||||||
101 | 129 | 157 | return $LastMethodCall; | ||||
102 | } | ||||||
103 | |||||||
104 | 1; |