| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package SimpleMock::Model::SUBS; |
|
2
|
5
|
|
|
5
|
|
26
|
use strict; |
|
|
5
|
|
|
|
|
6
|
|
|
|
5
|
|
|
|
|
143
|
|
|
3
|
5
|
|
|
5
|
|
17
|
use warnings; |
|
|
5
|
|
|
|
|
4
|
|
|
|
5
|
|
|
|
|
199
|
|
|
4
|
5
|
|
|
|
|
318
|
use SimpleMock::Util qw( |
|
5
|
|
|
|
|
|
|
generate_args_sha |
|
6
|
|
|
|
|
|
|
file_from_namespace |
|
7
|
5
|
|
|
5
|
|
15
|
); |
|
|
5
|
|
|
|
|
5
|
|
|
8
|
5
|
|
|
5
|
|
18
|
use Data::Dumper; |
|
|
5
|
|
|
|
|
5
|
|
|
|
5
|
|
|
|
|
1078
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our %DELEGATED; |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub validate_mocks { |
|
15
|
17
|
|
|
17
|
0
|
21
|
my $mocks_data = shift; |
|
16
|
|
|
|
|
|
|
|
|
17
|
17
|
|
|
|
|
23
|
my $new_mocks = {}; |
|
18
|
|
|
|
|
|
|
|
|
19
|
17
|
|
|
|
|
55
|
NAMESPACE: foreach my $ns (keys %$mocks_data) { |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# the module should already be loaded, but doesn't have to be |
|
22
|
17
|
|
|
|
|
23
|
eval { |
|
23
|
17
|
|
|
|
|
39
|
my $file = file_from_namespace($ns); |
|
24
|
17
|
|
|
|
|
33
|
require $file; |
|
25
|
|
|
|
|
|
|
}; |
|
26
|
17
|
50
|
|
|
|
33
|
$@ and die "Cannot load $ns - $@"; |
|
27
|
|
|
|
|
|
|
|
|
28
|
17
|
|
|
|
|
21
|
SUB: foreach my $sub (keys %{$mocks_data->{$ns}}) { |
|
|
17
|
|
|
|
|
36
|
|
|
29
|
20
|
|
|
|
|
39
|
SUBCALL: foreach my $subcall (@{ $mocks_data->{$ns}->{$sub}}) { |
|
|
20
|
|
|
|
|
31
|
|
|
30
|
29
|
|
|
|
|
74
|
my $sha = generate_args_sha($subcall->{args}); |
|
31
|
29
|
|
|
|
|
643
|
my $returns = $subcall->{returns}; |
|
32
|
29
|
|
|
|
|
74
|
$new_mocks->{SUBS}->{$ns}->{$sub}->{$sha} = $returns; |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# alias the subroutine to the mock service — only once per sub |
|
36
|
20
|
|
|
|
|
32
|
my $key = "$ns\::$sub"; |
|
37
|
20
|
100
|
|
|
|
56
|
unless ($DELEGATED{$key}) { |
|
38
|
14
|
|
|
|
|
24
|
$DELEGATED{$key} = 1; |
|
39
|
14
|
|
|
|
|
18
|
my $sub_full_name = $ns . '::' . $sub; |
|
40
|
5
|
|
|
5
|
|
39
|
no strict 'refs'; ## no critic |
|
|
5
|
|
|
|
|
6
|
|
|
|
5
|
|
|
|
|
169
|
|
|
41
|
5
|
|
|
5
|
|
23
|
no warnings 'redefine'; |
|
|
5
|
|
|
|
|
10
|
|
|
|
5
|
|
|
|
|
1411
|
|
|
42
|
14
|
|
|
29
|
|
51
|
*{$sub_full_name} = sub { _get_return_value_for_args($ns, $sub, \@_) }; |
|
|
14
|
|
|
|
|
95
|
|
|
|
29
|
|
|
|
|
8941
|
|
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
} |
|
45
|
|
|
|
|
|
|
} |
|
46
|
17
|
|
|
|
|
32
|
return $new_mocks; |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _get_return_value_for_args { |
|
50
|
29
|
|
|
29
|
|
60
|
my ($ns, $sub, $args) = @_; |
|
51
|
29
|
|
|
|
|
78
|
my $sha = generate_args_sha($args); |
|
52
|
|
|
|
|
|
|
|
|
53
|
29
|
|
|
|
|
1398
|
for my $layer (reverse @SimpleMock::MOCK_STACK) { |
|
54
|
30
|
100
|
|
|
|
106
|
my $mock_sub = $layer->{SUBS}{$ns}{$sub} or next; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# if no specific-args match, use layer _default, if exists |
|
57
|
|
|
|
|
|
|
my $returns = exists $mock_sub->{$sha} ? $mock_sub->{$sha} |
|
58
|
28
|
100
|
|
|
|
68
|
: exists $mock_sub->{'_default'} ? $mock_sub->{'_default'} |
|
|
|
100
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
: next; # nothing in this layer for this sub, keep looking down |
|
60
|
27
|
100
|
|
|
|
141
|
return ref($returns) eq 'CODE' ? $returns->(@$args) : $returns; |
|
61
|
|
|
|
|
|
|
} |
|
62
|
|
|
|
|
|
|
|
|
63
|
2
|
|
|
|
|
7
|
die "No mock found for $ns\::$sub with args: " . Dumper($args); |
|
64
|
|
|
|
|
|
|
} |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
1; |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 NAME |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
SimpleMock::Model::SUBS |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Allows you to override subroutines in a namespace with mock implementations. By |
|
75
|
|
|
|
|
|
|
using this along with reasonable design patterns, you can unit test your code |
|
76
|
|
|
|
|
|
|
in a very simple way. |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 USAGE |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head2 via SimpleMock::Mocks::* modules |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Use this approach to set global mocks for subs in your own code. If you have (say) |
|
83
|
|
|
|
|
|
|
a module called MyModule.pm with a sub called 'load_conf_file' that loads data and |
|
84
|
|
|
|
|
|
|
returns the content, to mock it, you would just add the sub to the relevant Mocks file, eg: |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
package SimpleMock::Mocks::MyModule; |
|
87
|
|
|
|
|
|
|
use strict; |
|
88
|
|
|
|
|
|
|
use warnings; |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub load_conf_file { |
|
91
|
|
|
|
|
|
|
return 'a static conf file'; |
|
92
|
|
|
|
|
|
|
} |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
1; |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
And that's it. In every test where you load SimpleMock, that mock will automatically |
|
97
|
|
|
|
|
|
|
load when your test code uses the MyMock module. |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 via calls to C and C |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# load this before any of the code that will need mocking |
|
102
|
|
|
|
|
|
|
use SimpleMock qw(register_mocks register_mocks_scoped); |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# this loads My::Module and, if they exist, the mocks in SimpleMock::Mocks::My::Module |
|
105
|
|
|
|
|
|
|
use My::Module; |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# manually register overrides |
|
108
|
|
|
|
|
|
|
register_mocks( |
|
109
|
|
|
|
|
|
|
# the model namespace |
|
110
|
|
|
|
|
|
|
SUBS => { |
|
111
|
|
|
|
|
|
|
# the namespace we are mocking in |
|
112
|
|
|
|
|
|
|
'My::Module' => { |
|
113
|
|
|
|
|
|
|
# the sub we are mocking |
|
114
|
|
|
|
|
|
|
'my_sub' => [ |
|
115
|
|
|
|
|
|
|
# mocks are hashrefs with keys 'args' and 'returns' |
|
116
|
|
|
|
|
|
|
# if 'args' is omitted, the 'returns' value is used as a default |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# return a specific value for these args |
|
119
|
|
|
|
|
|
|
{ args => [1, 2], |
|
120
|
|
|
|
|
|
|
returns => 'return value for args 1,2' }, |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# run the code reference for these args |
|
123
|
|
|
|
|
|
|
{ args => [3, 4], |
|
124
|
|
|
|
|
|
|
# just return a random number from 1 to 10 |
|
125
|
|
|
|
|
|
|
returns => sub { return int(rand(10))+1; } }, |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# return value for any other args |
|
128
|
|
|
|
|
|
|
# you can use a subref here (as above) for a more powerful default, |
|
129
|
|
|
|
|
|
|
# or just return a static value |
|
130
|
|
|
|
|
|
|
{ returns => sub { my ($arg1, $arg2) = @_; return $arg1+$arg2 } }, |
|
131
|
|
|
|
|
|
|
], |
|
132
|
|
|
|
|
|
|
}, |
|
133
|
|
|
|
|
|
|
}, |
|
134
|
|
|
|
|
|
|
); |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
If the catchall (returns with no args) is omitted, the sub call will die if the args |
|
137
|
|
|
|
|
|
|
sent do not match any of the defined mocks. |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
The return value can be a literal value, or a code reference. If it is a code |
|
140
|
|
|
|
|
|
|
reference, it will be called with the args passed to the subroutine. This is |
|
141
|
|
|
|
|
|
|
useful for generating dynamic return values based on the input arguments. You'll probably |
|
142
|
|
|
|
|
|
|
want static return values, but the sub ref option is there in case it's needed |
|
143
|
|
|
|
|
|
|
(eg for a random response). |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Use the coderef approach too if you need to return a hash or array, or if |
|
146
|
|
|
|
|
|
|
you need to support wantarray calls. I originally considered doing this via another |
|
147
|
|
|
|
|
|
|
key in the mock definition, but it seemed simpler to just use a coderef for these. |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
eg: |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
{ returns => sub { wantarray ? ('one', 'two', 'three') : 3; } } |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
If you want to override these default mocks temporarily in sub tests, you can use C |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# global test mocks are set at the beginning of the test, but we want to override |
|
156
|
|
|
|
|
|
|
# them for the next block only |
|
157
|
|
|
|
|
|
|
{ |
|
158
|
|
|
|
|
|
|
# assign to a scope guard, same arg syntax as for C |
|
159
|
|
|
|
|
|
|
my $scope_guard = register_mocks_scoped(...); |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# any tests you run here will use the mocks you have created above |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
# after the block ends, the scoped mocks are destroyed and the original mocks |
|
164
|
|
|
|
|
|
|
# are used again |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
There is a dummy app in the ./t directory of this distribution. Please examine to see examples |
|
167
|
|
|
|
|
|
|
of the different mocking options. |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=cut |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
|