File Coverage

blib/lib/Mock/Sub/Child.pm
Criterion Covered Total %
statement 108 108 100.0
branch 40 42 95.2
condition 26 31 83.8
subroutine 23 24 95.8
pod 11 11 100.0
total 208 216 96.3


line stmt bran cond sub pod time code
1             package Mock::Sub::Child;
2 15     15   232 use 5.006;
  15         50  
3 15     15   75 use strict;
  15         26  
  15         325  
4 15     15   73 use warnings;
  15         24  
  15         466  
5              
6 15     15   71 use Carp qw(croak);
  15         28  
  15         745  
7 15     15   75 use Scalar::Util qw(weaken);
  15         28  
  15         8442  
8              
9             our $VERSION = '1.05';
10              
11             sub new {
12 60     60 1 1320 my $self = bless {}, shift;
13 60         105 %{ $self } = @_;
  60         143  
14              
15 60 100       175 if ($self->{side_effect}){
16 2         6 $self->_check_side_effect($self->{side_effect});
17             }
18 59         174 return $self;
19             }
20             sub mock {
21 64     64 1 1824 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 64         78 my $sub_passed_in;
27 64 100 100     874 if ($_[0] && $_[0] =~ /::/){
28 55         84 $sub_passed_in = 1;
29             }
30              
31 64   100     474 my $caller = (caller(1))[3] || '';
32              
33 64 100 100     264 if ($caller ne 'Mock::Sub::mock' && $sub_passed_in){
34 3         8 undef @_;
35 3 100 66     26 if(ref($self) eq 'Mock::Sub::Child' && ! $self->{name}){
36 1         86 croak "can't call mock() on a child object before it is already " .
37             "initialized with the parent mock object. ";
38             }
39             }
40              
41 63   66     203 my $sub = $self->name || shift;
42              
43 63         126 my %p = @_;
44 63         156 for (keys %p){
45 2         6 $self->{$_} = $p{$_};
46             }
47              
48 63 100       187 if ($sub !~ /::/) {
49 3         9 my $core_sub = "CORE::" . $sub;
50              
51 3 100 66     58 if (defined &$core_sub && ${^GLOBAL_PHASE} eq 'START') {
52 1         21 warn "WARNING! we're attempting to override a global core " .
53             "function. You will NOT be able to restore functionality " .
54             "to this function.";
55              
56 1         7 $sub = "CORE::GLOBAL::" . $sub;
57             }
58             else {
59 2 50       11 $sub = "main::$sub" if $sub !~ /::/;
60             }
61             }
62              
63 63         81 my $fake;
64              
65 63 100 66     238 if (! exists &$sub && $sub !~ /CORE::GLOBAL/){
66 3         5 $fake = 1;
67 3         21 warn "\n\nWARNING!: we've mocked a non-existent subroutine. " .
68             "the specified sub does not exist.\n\n";
69             }
70              
71 63         181 $self->_check_side_effect($self->{side_effect});
72              
73 63 100       178 if (defined $self->{return_value}){
74 2         4 push @{ $self->{return} }, $self->{return_value};
  2         6  
75             }
76              
77 63         133 $self->{name} = $sub;
78 63 100       236 $self->{orig} = \&$sub if ! $fake;
79              
80 63         124 $self->{called_count} = 0;
81              
82             {
83 15     15   80 no strict 'refs';
  15         26  
  15         548  
  63         79  
84 15     15   71 no warnings 'redefine';
  15         25  
  15         4698  
85              
86 63         84 my $mock = $self;
87 63         179 weaken $mock;
88              
89             *$sub = sub {
90              
91 87     87   4448 @{ $mock->{called_with} } = @_;
  87         265  
92 87         135 ++$mock->{called_count};
93              
94 87 100       220 if ($mock->{side_effect}) {
95 14 100       32 if (wantarray){
96 2         7 my @effect = $mock->{side_effect}->(@_);
97 2 50       22 return @effect if @effect;
98             }
99             else {
100 12         37 my $effect = $mock->{side_effect}->(@_);
101 11 100       71 return $effect if defined $effect;
102             }
103             }
104              
105 74 100       242 return if ! $mock->{return};
106              
107             return ! wantarray && @{ $mock->{return} } == 1
108             ? $mock->{return}[0]
109 67 100 100     179 : @{ $mock->{return} };
  3         10  
110 63         372 };
111             }
112 63         126 $self->{state} = 1;
113              
114 63         179 return $self;
115             }
116             sub unmock {
117 69     69 1 3256 my $self = shift;
118 69         122 my $sub = $self->{name};
119              
120             {
121 15     15   79 no strict 'refs';
  15         24  
  15         604  
  69         86  
122 15     15   75 no warnings 'redefine';
  15         24  
  15         7053  
123              
124 69 100 66     361 if (defined $self->{orig} && $sub !~ /CORE::GLOBAL/) {
125 60         79 *$sub = \&{ $self->{orig} };
  60         532  
126             }
127             else {
128 9 100       85 undef *$sub if $self->{name};
129             }
130             }
131              
132 69         124 $self->{state} = 0;
133 69         154 $self->reset;
134             }
135             sub called {
136 14 100   14 1 45 return shift->called_count ? 1 : 0;
137             }
138             sub called_count {
139 33   100 33 1 232 return shift->{called_count} || 0;
140             }
141             sub called_with {
142 6     6 1 24 my $self = shift;
143 6 100       12 if (! $self->called){
144 1         142 croak "\n\ncan't call called_with() before the mocked sub has " .
145             "been called. ";
146             }
147 5         9 return @{ $self->{called_with} };
  5         16  
148             }
149             sub name {
150 71     71 1 338 return shift->{name};
151             }
152             sub reset {
153 74     74 1 1393 for (qw(side_effect return_value return called called_count called_with)){
154 444         1424 delete $_[0]->{$_};
155             }
156             }
157             sub return_value {
158 66     66 1 5070 my $self = shift;
159 66         103 @{ $self->{return} } = @_;
  66         272  
160             }
161             sub side_effect {
162 64     64 1 1972 $_[0]->_check_side_effect($_[1]);
163 61         203 $_[0]->{side_effect} = $_[1];
164             }
165             sub _check_side_effect {
166 129 100 100 129   502 if (defined $_[1] && ref $_[1] ne 'CODE') {
167 4         534 croak "\n\nside_effect parameter must be a code reference. ";
168             }
169             }
170             sub mocked_state {
171 35     35 1 1294 return shift->{state};
172             }
173             sub DESTROY {
174 60     60   28446 $_[0]->unmock;
175             }
176       0     sub _end {}; # vim fold placeholder
177              
178             __END__