File Coverage

blib/lib/Mock/Sub/Child.pm
Criterion Covered Total %
statement 113 113 100.0
branch 44 46 95.6
condition 28 34 82.3
subroutine 25 26 96.1
pod 11 11 100.0
total 221 230 96.0


line stmt bran cond sub pod time code
1             package Mock::Sub::Child;
2 18     18   227 use 5.006;
  18         38  
3 18     18   57 use strict;
  18         16  
  18         265  
4 18     18   63 use warnings;
  18         47  
  18         420  
5              
6 18     18   67 use Carp qw(confess);
  18         24  
  18         671  
7 18     18   66 use Scalar::Util qw(weaken);
  18         21  
  18         7771  
8              
9             our $VERSION = '1.07';
10              
11             sub new {
12 65     65 1 1199 my $self = bless {}, shift;
13 65         79 %{ $self } = @_;
  65         181  
14              
15 65 100       145 if ($self->{side_effect}){
16 2         5 $self->_check_side_effect($self->{side_effect});
17             }
18 64         93 return $self;
19             }
20             sub _mock {
21 73     73   77 my $self = shift;
22              
23             # throw away the sub name if it's sent in and we're not called
24             # by Mock::Sub::mock()
25              
26 73         57 my $sub_passed_in;
27 73 100 100     371 if ($_[0] && $_[0] =~ /::/){
28 60         60 $sub_passed_in = 1;
29             }
30              
31 73   50     442 my $caller = (caller(1))[3] || '';
32            
33 73 100 100     219 if ($caller ne 'Mock::Sub::mock' && $sub_passed_in){
34 3         6 undef @_;
35 3 100 66     30 if(ref($self) eq 'Mock::Sub::Child' && ! $self->{name}){
36 1         110 confess "can't call mock() on a child object before it is already " .
37             "initialized with the parent mock object. ";
38             }
39             }
40              
41 72 100 100     162 if ($caller ne 'Mock::Sub::mock' && $caller ne 'Mock::Sub::Child::remock'){
42 1         183 confess "the _mock() method is not a public API call. For re-mocking " .
43             "an existing sub in an existing sub object, use remock().\n";
44             }
45              
46 71   66     148 my $sub = $self->name || shift;
47              
48 71         94 my %p = @_;
49 71         159 for (keys %p){
50 3         7 $self->{$_} = $p{$_};
51             }
52              
53 71 100       165 if ($sub !~ /::/) {
54 3         6 my $core_sub = "CORE::" . $sub;
55              
56 3 100 66     54 if (defined &$core_sub && ${^GLOBAL_PHASE} eq 'START') {
57 1         15 warn "WARNING! we're attempting to override a global core " .
58             "function. You will NOT be able to restore functionality " .
59             "to this function.";
60              
61 1         5 $sub = "CORE::GLOBAL::" . $sub;
62             }
63             else {
64 2 50       10 $sub = "main::$sub" if $sub !~ /::/;
65             }
66             }
67              
68 71         65 my $fake;
69              
70 71 100 66     199 if (! exists &$sub && $sub !~ /CORE::GLOBAL/) {
71 5         6 $fake = 1;
72 5 100       15 if (! $self->_no_warn) {
73 4         18 warn "\n\nWARNING!: we've mocked a non-existent subroutine. ".
74             "the specified sub does not exist.\n\n";
75             }
76             }
77              
78 71         138 $self->_check_side_effect($self->{side_effect});
79              
80 71 100       150 if (defined $self->{return_value}){
81 3         3 push @{ $self->{return} }, $self->{return_value};
  3         8  
82             }
83              
84 71         80 $self->{name} = $sub;
85 71 100       189 $self->{orig} = \&$sub if ! $fake;
86              
87 71         95 $self->{called_count} = 0;
88              
89             {
90 18     18   84 no strict 'refs';
  18         20  
  18         554  
  71         54  
91 18     18   59 no warnings 'redefine';
  18         19  
  18         4155  
92              
93 71         64 my $mock = $self;
94 71         151 weaken $mock;
95              
96             *$sub = sub {
97              
98 88     88   3531 @{ $mock->{called_with} } = @_;
  88         222  
99 88         109 ++$mock->{called_count};
100              
101 88 100       159 if ($mock->{side_effect}) {
102 14 100       24 if (wantarray){
103 2         3 my @effect = $mock->{side_effect}->(@_);
104 2 50       21 return @effect if @effect;
105             }
106             else {
107 12         23 my $effect = $mock->{side_effect}->(@_);
108 11 100       46 return $effect if defined $effect;
109             }
110             }
111              
112 75 100       154 return if ! $mock->{return};
113              
114             return ! wantarray && @{ $mock->{return} } == 1
115             ? $mock->{return}[0]
116 68 100 100     126 : @{ $mock->{return} };
  3         7  
117 71         355 };
118             }
119 71         94 $self->{state} = 1;
120              
121 71         148 return $self;
122             }
123             sub remock {
124 11     11 1 1567 shift->_mock(@_);
125             }
126             sub unmock {
127 75     75 1 2777 my $self = shift;
128 75         89 my $sub = $self->{name};
129              
130             {
131 18     18   68 no strict 'refs';
  18         23  
  18         408  
  75         57  
132 18     18   55 no warnings 'redefine';
  18         25  
  18         6229  
133              
134 75 100 66     342 if (defined $self->{orig} && $sub !~ /CORE::GLOBAL/) {
135 64         54 *$sub = \&{ $self->{orig} };
  64         460  
136             }
137             else {
138 11 100       62 undef *$sub if $self->{name};
139             }
140             }
141              
142 74         79 $self->{state} = 0;
143 74         122 $self->reset;
144             }
145             sub called {
146 14 100   14 1 31 return shift->called_count ? 1 : 0;
147             }
148             sub called_count {
149 33   100 33 1 162 return shift->{called_count} || 0;
150             }
151             sub called_with {
152 6     6 1 21 my $self = shift;
153 6 100       8 if (! $self->called){
154 1         165 confess "\n\ncan't call called_with() before the mocked sub has " .
155             "been called. ";
156             }
157 5         5 return @{ $self->{called_with} };
  5         14  
158             }
159             sub name {
160 79     79 1 292 return shift->{name};
161             }
162             sub reset {
163 79     79 1 1207 for (qw(side_effect return_value return called called_count called_with)){
164 474         920 delete $_[0]->{$_};
165             }
166             }
167             sub return_value {
168 71     71 1 3641 my $self = shift;
169 71         76 @{ $self->{return} } = @_;
  71         183  
170             }
171             sub side_effect {
172 69     69 1 1446 $_[0]->_check_side_effect($_[1]);
173 66         121 $_[0]->{side_effect} = $_[1];
174             }
175             sub _check_side_effect {
176 142 100 100 142   383 if (defined $_[1] && ref $_[1] ne 'CODE') {
177 4         512 confess "\n\nside_effect parameter must be a code reference. ";
178             }
179             }
180             sub mocked_state {
181 38     38 1 1173 return shift->{state};
182             }
183             sub _no_warn {
184 5     5   12 return $_[0]->{no_warnings};
185             }
186             sub DESTROY {
187 65     65   27246 $_[0]->unmock;
188             }
189       0     sub _end {}; # vim fold placeholder
190              
191             __END__