File Coverage

blib/lib/Mock/Sub/Child.pm
Criterion Covered Total %
statement 111 111 100.0
branch 42 44 95.4
condition 28 34 82.3
subroutine 24 25 96.0
pod 11 11 100.0
total 216 225 96.0


line stmt bran cond sub pod time code
1             package Mock::Sub::Child;
2 16     16   301 use 5.006;
  16         55  
3 16     16   80 use strict;
  16         30  
  16         365  
4 16     16   78 use warnings;
  16         29  
  16         510  
5              
6 16     16   80 use Carp qw(croak);
  16         26  
  16         797  
7 16     16   85 use Scalar::Util qw(weaken);
  16         24  
  16         9971  
8              
9             our $VERSION = '1.06';
10              
11             sub new {
12 63     63 1 1698 my $self = bless {}, shift;
13 63         121 %{ $self } = @_;
  63         196  
14              
15 63 100       197 if ($self->{side_effect}){
16 2         6 $self->_check_side_effect($self->{side_effect});
17             }
18 62         167 return $self;
19             }
20             sub _mock {
21 71     71   110 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 71         92 my $sub_passed_in;
27 71 100 100     444 if ($_[0] && $_[0] =~ /::/){
28 58         91 $sub_passed_in = 1;
29             }
30              
31 71   50     524 my $caller = (caller(1))[3] || '';
32              
33 71 100 100     306 if ($caller ne 'Mock::Sub::mock' && $sub_passed_in){
34 3         7 undef @_;
35 3 100 66     24 if(ref($self) eq 'Mock::Sub::Child' && ! $self->{name}){
36 1         93 croak "can't call mock() on a child object before it is already " .
37             "initialized with the parent mock object. ";
38             }
39             }
40              
41 70 100 100     242 if ($caller ne 'Mock::Sub::mock' && $caller ne 'Mock::Sub::Child::remock'){
42 1         161 croak "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 69   66     191 my $sub = $self->name || shift;
47              
48 69         138 my %p = @_;
49 69         203 for (keys %p){
50 3         9 $self->{$_} = $p{$_};
51             }
52              
53 69 100       240 if ($sub !~ /::/) {
54 3         10 my $core_sub = "CORE::" . $sub;
55              
56 3 100 66     53 if (defined &$core_sub && ${^GLOBAL_PHASE} eq 'START') {
57 1         19 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         7 $sub = "CORE::GLOBAL::" . $sub;
62             }
63             else {
64 2 50       10 $sub = "main::$sub" if $sub !~ /::/;
65             }
66             }
67              
68 69         116 my $fake;
69              
70 69 100 66     306 if (! exists &$sub && $sub !~ /CORE::GLOBAL/){
71 3         4 $fake = 1;
72 3         20 warn "\n\nWARNING!: we've mocked a non-existent subroutine. " .
73             "the specified sub does not exist.\n\n";
74             }
75              
76 69         218 $self->_check_side_effect($self->{side_effect});
77              
78 69 100       196 if (defined $self->{return_value}){
79 3         6 push @{ $self->{return} }, $self->{return_value};
  3         11  
80             }
81              
82 69         122 $self->{name} = $sub;
83 69 100       277 $self->{orig} = \&$sub if ! $fake;
84              
85 69         148 $self->{called_count} = 0;
86              
87             {
88 16     16   96 no strict 'refs';
  16         30  
  16         627  
  69         90  
89 16     16   80 no warnings 'redefine';
  16         28  
  16         5511  
90              
91 69         101 my $mock = $self;
92 69         186 weaken $mock;
93              
94             *$sub = sub {
95              
96 88     88   4695 @{ $mock->{called_with} } = @_;
  88         244  
97 88         145 ++$mock->{called_count};
98              
99 88 100       249 if ($mock->{side_effect}) {
100 14 100       32 if (wantarray){
101 2         6 my @effect = $mock->{side_effect}->(@_);
102 2 50       23 return @effect if @effect;
103             }
104             else {
105 12         38 my $effect = $mock->{side_effect}->(@_);
106 11 100       90 return $effect if defined $effect;
107             }
108             }
109              
110 75 100       252 return if ! $mock->{return};
111              
112             return ! wantarray && @{ $mock->{return} } == 1
113             ? $mock->{return}[0]
114 68 100 100     195 : @{ $mock->{return} };
  3         10  
115 69         426 };
116             }
117 69         143 $self->{state} = 1;
118              
119 69         221 return $self;
120             }
121             sub remock {
122 11     11 1 1878 shift->_mock(@_);
123             }
124             sub unmock {
125 73     73 1 2622 my $self = shift;
126 73         126 my $sub = $self->{name};
127              
128             {
129 16     16   86 no strict 'refs';
  16         33  
  16         476  
  73         93  
130 16     16   80 no warnings 'redefine';
  16         34  
  16         7796  
131              
132 73 100 66     404 if (defined $self->{orig} && $sub !~ /CORE::GLOBAL/) {
133 64         89 *$sub = \&{ $self->{orig} };
  64         576  
134             }
135             else {
136 9 100       52 undef *$sub if $self->{name};
137             }
138             }
139              
140 72         139 $self->{state} = 0;
141 72         162 $self->reset;
142             }
143             sub called {
144 14 100   14 1 47 return shift->called_count ? 1 : 0;
145             }
146             sub called_count {
147 33   100 33 1 222 return shift->{called_count} || 0;
148             }
149             sub called_with {
150 6     6 1 24 my $self = shift;
151 6 100       9 if (! $self->called){
152 1         156 croak "\n\ncan't call called_with() before the mocked sub has " .
153             "been called. ";
154             }
155 5         7 return @{ $self->{called_with} };
  5         25  
156             }
157             sub name {
158 77     77 1 359 return shift->{name};
159             }
160             sub reset {
161 77     77 1 1449 for (qw(side_effect return_value return called called_count called_with)){
162 462         1447 delete $_[0]->{$_};
163             }
164             }
165             sub return_value {
166 69     69 1 4768 my $self = shift;
167 69         105 @{ $self->{return} } = @_;
  69         282  
168             }
169             sub side_effect {
170 67     67 1 1977 $_[0]->_check_side_effect($_[1]);
171 64         206 $_[0]->{side_effect} = $_[1];
172             }
173             sub _check_side_effect {
174 138 100 100 138   569 if (defined $_[1] && ref $_[1] ne 'CODE') {
175 4         501 croak "\n\nside_effect parameter must be a code reference. ";
176             }
177             }
178             sub mocked_state {
179 38     38 1 1258 return shift->{state};
180             }
181             sub DESTROY {
182 63     63   32481 $_[0]->unmock;
183             }
184       0     sub _end {}; # vim fold placeholder
185              
186             __END__