File Coverage

blib/lib/Test/EasyMock/MockControl.pm
Criterion Covered Total %
statement 78 78 100.0
branch 8 8 100.0
condition 10 12 83.3
subroutine 24 24 100.0
pod 11 11 100.0
total 131 133 98.5


line stmt bran cond sub pod time code
1             package Test::EasyMock::MockControl;
2 9     9   54 use strict;
  9         13  
  9         359  
3 9     9   47 use warnings;
  9         16  
  9         289  
4              
5             =head1 NAME
6              
7             Test::EasyMock::MockControl - Control behavior of the mock object.
8              
9             =cut
10 9     9   8430 use Data::Dump qw(pp);
  9         58700  
  9         815  
11 9     9   8588 use Data::Util qw(is_instance);
  9         9490  
  9         752  
12 9     9   93 use List::Util qw(first);
  9         16  
  9         932  
13 9     9   47 use Scalar::Util qw(blessed);
  9         17  
  9         432  
14 9     9   54 use Test::Builder;
  9         14  
  9         221  
15 9     9   48 use Test::EasyMock::ArgumentsMatcher;
  9         15  
  9         200  
16 9     9   4933 use Test::EasyMock::Expectation;
  9         28  
  9         230  
17 9     9   4908 use Test::EasyMock::ExpectationSetters;
  9         24  
  9         249  
18 9     9   10721 use Test::EasyMock::MockObject;
  9         22  
  9         7437  
19              
20             my $tb = Test::Builder->new();
21              
22             =head1 CLASS METHODS
23              
24             =head2 create_control
25              
26             Create a default control instance.
27              
28             =cut
29             sub create_control {
30 8     8 1 21 my $class = shift;
31 8         37 return $class->new(@_);
32             }
33              
34             =head1 CONSTRUCTORS
35              
36             =head2 new([$module|$object])
37              
38             Create a instance.
39              
40             =cut
41             sub new {
42 8     8 1 19 my ($class, $module_or_object) = @_;
43 8         40 my $blessed = blessed $module_or_object;
44 8   100     116 return bless {
      66        
45             _module => $blessed || $module_or_object,
46             _object => $blessed && $module_or_object,
47             }, $class;
48             }
49              
50             =head1 INSTANCE METHODS
51              
52             =head2 create_mock
53              
54             Create a mock instance.
55              
56             =cut
57             sub create_mock {
58 8     8 1 22 my ($self) = @_;
59 8         48 return bless {
60             _control => $self,
61             }, 'Test::EasyMock::MockObject';
62             }
63              
64             =head2 process_method_invocation($mock, $method, @args)
65              
66             Process method invocation.
67             Dispatch to replay or record method.
68              
69             =cut
70             sub process_method_invocation {
71 103     103 1 234 my ($self, $mock, $method, @args) = @_;
72 103 100       410 return $self->{_is_replay_mode}
73             ? $self->replay_method_invocation($mock, $method, @args)
74             : $self->record_method_invocation($mock, $method, @args);
75             }
76              
77             =head2 replay_method_invocation($mock, $method, @args)
78              
79             Replay the method invocation.
80              
81             =cut
82             sub replay_method_invocation {
83 51     51 1 105 my ($self, $mock, $method, @args) = @_;
84 51         267 my $expectation = $self->find_expectation({
85             mock => $mock,
86             method => $method,
87             args => \@args,
88             });
89 51         192 my $object = $self->{_object};
90              
91 51         257 my $method_detail = "(method: $method, args: " . pp(@args) . ')';
92              
93 51 100 66     4958 if ($expectation) {
    100          
94 44         244 $tb->ok(1, 'Expected mock method invoked.'.$method_detail);
95 44         19115 return $expectation->retrieve_result();
96             }
97             elsif ($object && $object->can($method)) {
98 1         11 return $object->$method(@args);
99             }
100             else {
101 6         60 $tb->ok(0, 'Unexpected mock method invoked.'.$method_detail);
102 6         859 return;
103             }
104             }
105              
106             =head2 record_method_invocation($mock, $method, @args)
107              
108             Record the method invocation.
109              
110             =cut
111             sub record_method_invocation {
112 52     52 1 118 my ($self, $mock, $method, @args) = @_;
113 52 100       508 my $expectation = Test::EasyMock::Expectation->new({
114             method => $method,
115             args => is_instance($args[0], 'Test::EasyMock::ArgumentsMatcher')
116             ? $args[0]
117             : Test::EasyMock::ArgumentsMatcher->new(\@args),
118             });
119 52         356 return ($mock, $expectation);
120             }
121              
122             =head2 find_expectation($args)
123              
124             Find the expectation by arguments.
125              
126             =cut
127             sub find_expectation {
128 51     51 1 72 my ($self, $args) = @_;
129 115         74624 my @expectations = grep { $_->matches($args) }
  51         113  
130 51         70 @{$self->{_expectations}};
131              
132 51     56   82157 my $result = first { $_->has_result } @expectations;
  56         234  
133 51   100 26   369 return $result || first { $_->has_stub_result } @expectations;
  26         110  
134             }
135              
136             =head2 expect($expectation)
137              
138             Record the expectation of the mock method invocation.
139              
140             =cut
141             sub expect {
142 52     52 1 78 my ($self, $mock, $expectation) = @_;
143 52         74 push @{$self->{_expectations}}, $expectation;
  52         118  
144 52         241 return Test::EasyMock::ExpectationSetters->new($expectation);
145             }
146              
147             =head2 replay
148              
149             Change to I mode.
150              
151             =cut
152             sub replay {
153 34     34 1 45 my ($self) = @_;
154 34         151 $self->{_is_replay_mode} = 1;
155             }
156              
157             =head2 reset
158              
159             Clear expectations and change to I mode.
160              
161             =cut
162             sub reset {
163 31     31 1 50 my ($self) = @_;
164 31         63 $self->{_is_replay_mode} = 0;
165 31         330 $self->{_expectations} = [];
166             }
167              
168             =head2 verify
169              
170             Verify the mock method invocations.
171              
172             =cut
173             sub verify {
174 28     28 1 59 my ($self) = @_;
175 2         7 my $unsatisfied_message =
176 47         144 join "\n", map { $_->unsatisfied_message }
177 28         75 grep { !$_->is_satisfied }
178 28         95 @{$self->{_expectations}};
179 28         176 $tb->is_eq($unsatisfied_message, '', 'verify mock invocations.');
180             }
181              
182             1;