File Coverage

blib/lib/Class/Mockable.pm
Criterion Covered Total %
statement 52 52 100.0
branch 5 6 83.3
condition n/a
subroutine 12 12 100.0
pod n/a
total 69 70 98.5


line stmt bran cond sub pod time code
1             package Class::Mockable;
2              
3 3     3   159572 use strict;
  3         20  
  3         89  
4 3     3   22 use warnings;
  3         6  
  3         81  
5 3     3   15 no strict 'refs';
  3         6  
  3         1071  
6              
7             our $VERSION = '1.3001';
8              
9             our %mocks;
10              
11             sub import {
12 4     4   26 my $class = shift;
13 4         17 my %args = @_;
14              
15 4         14 my $caller = (caller())[0];
16              
17 4         17 MOCK: foreach my $mock (keys %args) {
18              
19             # For the special mock key 'methods', add mockability to the
20             # methods defined.
21 5 100       23 if (lc $mock eq 'methods') {
22 2         7 _add_method_mocking($caller, $args{$mock});
23 2         82 next MOCK;
24             }
25              
26             # And add mocking for classes.
27 3         11 my $singleton_name = "${caller}::$mock";
28 3         10 $mocks{$singleton_name} = $args{$mock};
29 3         26 *{"${caller}::_reset$mock"} = sub {
30 6     6   45 $mocks{$singleton_name} = $args{$mock};
31 3         11 };
32 3         164 *{"${caller}::$mock"} = sub {
33 47     47   145732 shift;
34 47 100       123 if(exists($_[0])) { $mocks{$singleton_name} = shift; }
  19         78  
35 47         164 $mocks{$singleton_name}
36 3         14 };
37             }
38             }
39              
40             # Method mocking is slightly different, in that we need to create a setter, so
41             # that the method can be replaced with a method mocker test interface or
42             # code ref to do something else, as well as setting up the actual mock method
43             # accessor to be used.
44              
45             sub _add_method_mocking {
46 2     2   4 my $caller = shift;
47 2         2 my $method_mocks = shift;
48              
49 2         4 for my $wrapper (keys %{$method_mocks}) {
  2         6  
50 3         10 my $singleton_name = "${caller}::$wrapper";
51 3         6 my $wrapped = $method_mocks->{$wrapper};
52              
53             # I just invented the create-and-execute-subroutine operator :-)
54 3         5 &{*{"${caller}::_reset$wrapper"} = sub {
  3         22  
55 3     3   24 no warnings 'redefine';
  3         6  
  3         424  
56 8         61 *{"${caller}::$wrapper"} = sub {
57 5     5   1335 my $invocant = shift;
58 5         26 $invocant->$wrapped(@_);
59 8     8   4296 };
60 3         12 }};
61              
62 3         14 *{"${caller}::_set$wrapper"} = sub {
63 13     13   1080 my $invocant = shift;
64 13 50       40 if (exists($_[0])) {
65 3     3   31 no warnings 'redefine';
  3         6  
  3         336  
66 13         23 *{"${caller}::$wrapper"} = shift;
  13         123  
67             }
68 3         10 };
69             }
70             }
71              
72             1;
73              
74             =head1 NAME
75              
76             Class::Mockable
77              
78             =head1 DESCRIPTION
79              
80             A handy mix-in for making stuff mockable.
81              
82             Use this so that when testing your code you can easily mock how your
83             code talks to other bits of code, thus making it possible to test
84             your code in isolation, and without relying on third-party services.
85              
86             =head1 SYNOPSIS
87              
88             use Class::Mockable
89             _email_sender => 'Email::Sender::Simple',
90             _email_sent_storage => 'MyApp::Storage::EmailSent';
91              
92             is equivalent to:
93              
94             {
95             my $email_sender;
96             _reset_email_sender();
97             sub _reset_email_sender {
98             $email_sender = 'Email::Sender::Simple'
99             };
100             sub _email_sender {
101             my $class = shift;
102             if (exists($_[0])) { $email_sender = shift; }
103             return $email_sender;
104             }
105              
106             my $email_sent_storage;
107             _reset_email_sent_storage();
108             sub _reset_email_sent_storage {
109             $email_sent_storage = 'MyApp::Storage::EmailSent'
110             };
111             sub _email_sent_storage {
112             my $class = shift;
113             if (exists($_[0])) { $email_sent_storage = shift; }
114             return $email_sent_storage;
115             }
116             }
117              
118             =head1 HOW TO USE IT
119              
120             After setting up as above, the anywhere that your code would want to refer to the class
121             'Email::Sender::Simple', for example, you would do this:
122              
123             my $sender = $self->_email_sender();
124              
125             In your tests, you would do this:
126              
127             My::Module->_email_sender('MyApp::Tests::Mocks::EmailSender');
128             ok(My::Module->send_email(...), "email sending stuff works");
129              
130             where 'MyApp::Tests::Mocks::EmailSender' pretends to be the real email
131             sending class, only without spamming everyone every time you run the tests.
132             And of course, if you do want to really send email from a test - perhaps
133             you want to do an end-to-end test before releasing - you would do this:
134              
135             My::Module->_reset_email_sender() if($ENV{RELEASE_TESTING});
136             ok(My::Module->send_email(...),
137             "email sending stuff works (without mocking)");
138              
139             to restore the default functionality.
140              
141              
142             =head2 METHOD MOCKING
143              
144             We also provide a way of easily inserting shims that wrap around methods
145             that you have defined.
146              
147             use Class::Mockable
148             methods => {
149             _foo => 'foo',
150             };
151              
152             The above will create a _foo sub on your class that by default will call your
153             class's foo() subroutine. This behaviour can be changed by calling the setter
154             function _set_foo (where _foo is your identifier). The default behaviour can be
155             restored by calling _reset_foo (again, where _foo is your identifier).
156              
157             For example:
158              
159             package Some::Module;
160              
161             use Class::Mockable
162             methods => {
163             _bar => 'bar',
164             };
165              
166             sub bar {
167             my $self = shift;
168             return "Bar";
169             }
170              
171             sub foo {
172             my $self = shift;
173             return $self->_bar();
174             }
175              
176             package main;
177              
178             Some::Module->_set_bar(
179             sub {
180             my $self = shift;
181             return "Foo";
182             }
183             );
184              
185             print Some::Module->bar(); # Prints "Bar"
186             print Some::Module->foo(); # Prints "Foo"
187              
188             Some::Module->_reset_bar();
189              
190             print Some::Module->bar(); # Prints "Bar"
191             print Some::Module->foo(); # Prints "Bar"
192              
193             It will also work for inserting a shim into a subclass to wrap around a method
194             inherited from a superclass.
195              
196             =head1 CAVEATS
197              
198             If you use L in the same module as this it may
199             "helpfully" delete mocked methods that you create. You may need to
200             explicitly exclude those from namespace::autoclean's list of things to
201             clean.
202              
203             =head1 AUTHOR
204              
205             Copyright 2012-13 UK2 Ltd and David Cantrell Edavid@cantrell.org.ukE
206              
207             With some bits from James Ronan
208              
209             This software is free-as-in-speech software, and may be used, distributed,
210             and modified under the terms of either the GNU General Public Licence
211             version 2 or the Artistic Licence. It's up to you which one you use. The
212             full text of the licences can be found in the files GPL2.txt and
213             ARTISTIC.txt, respectively.
214              
215             =head1 SOURCE CODE REPOSITORY
216              
217             Egit://github.com/DrHyde/perl-modules-Class-Mockable.gitE
218              
219             =head1 BUGS/FEEDBACK
220              
221             Please report bugs at Github
222             Ehttps://github.com/DrHyde/perl-modules-Class-Mockable/issuesE
223              
224             =head1 CONSPIRACY
225              
226             This software is also free-as-in-mason.
227              
228             =cut