File Coverage

blib/lib/Test/Mock/LWP/Distilled.pm
Criterion Covered Total %
statement 88 88 100.0
branch 29 34 85.2
condition 7 9 77.7
subroutine 13 13 100.0
pod 0 2 0.0
total 137 146 93.8


line stmt bran cond sub pod time code
1             package Test::Mock::LWP::Distilled;
2              
3 3     3   191813 use English qw(-no_match_vars);
  3         4314  
  3         16  
4              
5 3     3   1707 use Moo::Role;
  3         29476  
  3         14  
6 3     3   4229 use Types::Standard qw(ArrayRef Bool CodeRef Enum HashRef);
  3         194152  
  3         42  
7              
8 3     3   3408 use Carp;
  3         6  
  3         159  
9 3     3   1257 use Data::Compare;
  3         33041  
  3         16  
10 3     3   10706 use Data::Dumper;
  3         17459  
  3         159  
11 3     3   778 use JSON::MaybeXS;
  3         9620  
  3         152  
12 3     3   1154 use Path::Class;
  3         90379  
  3         3683  
13              
14             # Have you updated the version number in the POD below?
15             our $VERSION = '0.001_03';
16             $VERSION = eval $VERSION;
17              
18             =head1 NAME
19              
20             Test::Mock::LWP::Distilled - make and use LWP mocks, distilled to their essence
21              
22             =head1 VERSION
23              
24             This is version 0.001_03 - a developer release.
25              
26             =head1 SYNOPSIS
27              
28             package My::Test::LWP::UserAgent;
29              
30             use Moo;
31             extends 'LWP::UserAgent';
32             with 'Test::Mock::LWP::Distilled';
33            
34             use LWP::JSON::Tiny;
35            
36             # The suffix we use for our mock filename, to distinguish it from other mocks.
37             sub filename_suffix { 'my-test' }
38            
39             # All our requests are GET requests to unique URLs.
40             sub distilled_request_from_request {
41             my ($self, $request) = @_;
42            
43             return $request->uri->path;
44             }
45            
46             # The JSON we get back is good to store; there are no passwords or pesky
47             # auto-increment fields to ignore.
48             sub distilled_response_from_response {
49             my ($self, $response) = @_;
50            
51             return $response->json_content;
52             }
53            
54             sub response_from_distilled_response {
55             my ($self, $distilled_response) = @_;
56            
57             my $response = HTTP::Response::JSON->new;
58             $response->json_content($distilled_response);
59             return $response;
60             }
61            
62             package Some::Test;
63            
64             use My::Test::LWP::UserAgent;
65             my $ua = My::Test::LWP::UserAgent->new(
66             base_dir => '/dev/test_data/mock',
67             file_name_from_calling_class => 1,
68             );
69             # Mocks are stored in, and fetched from,
70             #/dev/test_data/mock/Some/Test-my-test.json
71              
72             =head1 DESCRIPTION
73              
74             There are plenty of simple LWP-mocking modules. Test::Mock::LWP::Distilled
75             aims for something slightly more complicated, and therefore a lot more useful.
76              
77             =head2 Design ethos
78              
79             Test::Mock::LWP::Distilled does a couple of things beyond just letting you
80             inject mocks into your tests.
81              
82             =head3 Automatic recording and replaying of mocks
83              
84             Set the environment variable REGENERATE_MOCK_FILE=1 and
85             Test::Mock::LWP::Distilled will talk to a live system and, when it's done,
86             update a mock file with the results (distilled - see below) of what you
87             sent to your remote system and what you got back. These are written out in
88             canonical, pretty-printed JSON so a diff between two versions reveals only
89             the bits that actually changed.
90              
91             =head3 Distilling
92              
93             Requests and responses are I to the minimum you need to accurately
94             represent them. Your request probably always goes to the same host, and URLs
95             probably start with a common prefix. Even if things are more complex, you
96             certainly don't need to record every single HTTP header in your request.
97              
98             And if your request is a bunch of URL-encoded parameters, the distilled
99             version of your request I C; it's
100             actually
101              
102             {
103             "baz": "bletch",
104             "foo": "bar",
105             "toto": "titi"
106             }
107              
108             Similarly, if you get JSON back from a remote service, it's probably made as
109             compact as possible so it can be squirted down the wire efficiently.
110             But you can't read that as a human being, so you may as well turn
111             it into a Perl data structure, which will then be serialised to JSON in a nice
112             pretty-printed, sorted way.
113              
114             This is also the place where you occult passwords or other sensitive
115             information, or otherwise get rid of data that you don't care about. The end
116             point is, ideally, something that matches real-life data I
117             cares about>; a trade-off between accuracy and legibility, where you keep as
118             much information as you can afford, and get rid of chatter that just gets in
119             your way.
120              
121             =head2 How this works
122              
123             Run your tests using REGENERATE_MOCK_FILE=1 and Test::Mock::LWP::Distilled
124             will record all requests made using your mock user agent object, remembering
125             the distilled requests and responses in a mock file.
126              
127             Run your tests without that environment variable, and the mock user agent will
128             distill each request, and check it against the I.
129             If it matches, it will produce a genuine-looking response from the distilled
130             version and return it to the calling code. If it doesn't, it dies.
131              
132             If, when the mock user agent goes out of scope, there are unused mocks left,
133             it dies, so you know something went wrong. Time to regenerate those mocks and
134             look at the diff!
135              
136             =head2 Using Test::Mock::LWP::Distilled
137              
138             There's two things you need to do: set up a mocking class, and using it in your
139             tests.
140              
141             =head3 Setting up a mocking class
142              
143             Your class should be a Moo class that extends LWP::UserAgent (or a subclass of
144             your choice), and uses the role Test::Mock::LWP::Distilled. Have a look at
145             t/lib/Simple/Mock/Class.pm in the distribution for a ridiculously cut-down
146             example.
147              
148             You should implement the following methods, described in more detail below:
149              
150             =over
151              
152             =item filename_suffix
153              
154             Returns the suffix to use in the mock filename. This is so you can potentially
155             use two or more mock user agents in the same test class or script, and store
156             their mocks in similar places without one file overwriting the other.
157              
158             =item distilled_request_from_request
159              
160             Take a HTTP::Request object and distill just the information in it that you
161             need to reliably differentiate one request from another, as per How this
162             works above.
163              
164             This will be serialised to JSON in the mock file.
165              
166             =item distilled_response_from_response
167              
168             Take a HTTP::Response object and distill it down to the information you need
169             to store.
170              
171             This will be serialised to JSON in the mock file.
172              
173             =item response_from_distilled_response
174              
175             Take the data structure you generated earlier and generate a HTTP::Response
176             object from it, so you can feed it to code that expected to be talking to a
177             live website.
178              
179             =back
180              
181             =head3 Using the class in your code
182              
183             This is mostly a matter of creating a mock user agent and passing it to any
184             code that would otherwise have used a live user agent, but there's another
185             consideration you need to make: where the mock file lives.
186              
187             Test::Mock::LWP::Distilled uses three bits of data to work out the full
188             path name:
189              
190             =over
191              
192             =item C
193              
194             This is the base directory where your mocks live. This is an argument
195             passed to the constructor.
196              
197             =item test name derived from your test file or class
198              
199             If you pass C to the constructor,
200             the test name will be derived from the I name. Otherwise, the test
201             name will be derived from the I name, with any directories called "t"
202             removed.
203              
204             =item suffix
205              
206             This is the concatenation of hyphen C<->, the result of the C
207             method implemented by your user agent, and C<.json>.
208              
209             =back
210              
211             Let's assume your mock user agent is the one from the synopsis,
212             My::Test::LWP::UserAgent, which says
213              
214             sub filename_suffix { 'my-test' }
215              
216             and your code is in a file called /dev/company/module/t/vendor/tests.t.
217              
218             If you're happy that the filename is useful, you might want to say
219              
220             my $ua = My::Test::LWP::UserAgent->new(
221             base_dir => '/dev/company/test_data',
222             );
223              
224             and the mocks will be stored in, and read from,
225             /dev/company/test_data/vendor/tests-my-test.json
226              
227             If it's e.g. a Test::Class::Moose file with a proper package name,
228             you might want to write something like this:
229              
230             package Some::Test::Class::Moose::Test::Class {
231             has simple_api_user_agent => (
232             ...
233             lazy => 1,
234             builder => '_build_simple_api_user_agent',
235             );
236             sub _build_simple_api_user_agent {
237             My::Test::LWP::UserAgent->new(
238             base_dir => '/dev/company/test_data',
239             file_name_from_calling_class => 1,
240             );
241             }
242             }
243              
244             And your mocks will be stored in, and read from,
245             /dev/company/test_data/Some/Test/Class/Moose/Test/Class-my-test.json
246              
247             =head2 Methods you must implement
248              
249             =head3 filename_suffix
250              
251             Out: $filename_suffix
252              
253             You must return the suffix to use when generating a filename to store mocks in.
254              
255             As the resulting file will look like
256             I/I/I-I.json - note the hyphen before the
257             suffix - you might consider using kebab-case for this suffix, rather than
258             camelCase or snake_case.
259              
260             =cut
261              
262             requires 'filename_suffix';
263              
264             =head3 distilled_request_from_request
265              
266             In: $request (HTTP::Request object or subclass)
267             Out: $distilled_request (JSON-serializable data)
268              
269             Supplied with a HTTP::Request object (or subclass thereof), you must
270             return a variable of I that can be serialised to JSON (so no globs
271             or blessed references), that you are confident accurately represents the
272             distilled essence of this request. All the data you need to say "that's the
273             request I was talking about", and no more.
274              
275             You do not need to make each distilled request identical! If your tests
276             log in multiple times as different users, you probably want to capture the user
277             they log in as rather than blithely saying "we log in as some user, don't care
278             which".
279              
280             But Test::Mock::LWP::Distilled will throw an exception if your tests do not
281             make the calls you expected, which means that you can rely on all the previous
282             calls you expected actually having happened.
283              
284             So suppose you have an external API that lets you log in as a user, and get
285             some data corresponding to them. The requests might look like this:
286              
287             POST /api/login.version1
288             Host: api.somevendor.com
289            
290             username=user1&password=hunter2
291              
292             GET /api/user-data.version1
293             Host: api.somevendor.com
294              
295             POST /api/login.version1
296             Host: api.somevendor.com
297            
298             username=user2&password=12345
299              
300             GET /api/user-data.version1
301             Host: api.somevendor.com
302              
303             You would be perfectly justified in distilling these four requests as
304              
305             [
306             {
307             method => 'POST',
308             command => 'login',
309             params => {
310             username => 'user1',
311             }
312             },
313             {
314             method => 'GET',
315             command => 'user-data',
316             },
317             {
318             method => 'POST',
319             command => 'login',
320             params => {
321             username => 'user2',
322             }
323             },
324             {
325             method => 'GET',
326             command => 'user-data',
327             },
328             ]
329              
330             Most obviously, all of these calls are to the same host, and have the same
331             C prefix and the same C<.version1> suffix, so there's no need to store
332             that.
333              
334             More interestingly, you don't need to specify the password in the login request
335             (and arguably you shouldn't because the less you store this sort of thing, even
336             in a test environment, the better; plus, if you ever change the password you
337             need to regenerate the mocks, even though none of the test I has
338             changed).
339              
340             In fact, a case could be made that you don't need to store the method either.
341             Only if there's a difference between e.g. GET /api/user-data.version1,
342             PATCH /api/user-data.version1 and/or DELETE /api/user-data.version1 would you
343             need to store that.
344              
345             B, what if your tests also include "if you log in incorrectly, you get
346             told off and you can't get user data" and "once you've logged out, you can't
347             reuse your security credentials again"? You might have to add to the user-data
348             requests, details of the encrypted thingy you got back from the login response,
349             because you want to distinguish "I just logged in as user B and I'm allowed to
350             get stuff" from "I'm no longer logged in as user A, so I can't use the old
351             authentication credentials again".
352              
353             Ultimately, the mocks are for (a) your test code but also (b) the human being
354             reviewing the tests to make sure that they make sense. They need to contain
355             enough information for the tests to work, and for the reviewer to understand
356             what's going on, but not so much information that the tests still work but
357             the reviewer no longer understands what's going on.
358              
359             =cut
360              
361             requires 'distilled_request_from_request';
362              
363             =head3 distilled_response_from_response
364              
365             In: $response (HTTP::Response object or subclass)
366             Out: $distilled_response (JSON-serialisable data)
367              
368             Supplied with a HTTP::Response object (or subclass thereof), you must return a
369             variable or data structure that represents the essential nature of this
370             response. As with L, the point is to winnow
371             away the unnecessary chaff and keep only that information you and your tests
372             need.
373              
374             So, to take the simple example from above with four requests, you might
375             plausibly distill them down to
376              
377             [
378             {},
379             {
380             username => 'user1',
381             # data returned for the first user
382             },
383             {},
384             {
385             username => 'user2,
386             # data returned for the second user
387             }
388             ]
389              
390             because all of the calls were successes, and the login requests didn't return
391             any content.
392              
393             But if you added tests that you got knocked back if you logged in with
394             incorrect credentials, I your code decided what to do by looking at the
395             HTTP code of the response first, then falling back to the JSON contents, you
396             should also include an HTTP code in your distilled responses.
397              
398             And if your distilled I included some encrypted thingy that they
399             remembered from a previous call, then you I to include that in your
400             distilled response. Maybe your data structure wants to become e.g.
401              
402             {
403             headers => {
404             authentication => '...',
405             },
406             data => {},
407             }
408              
409             vs
410              
411             {
412             data => {
413             username => 'user1',
414             # etc. etc.
415             }
416             }
417              
418             =cut
419              
420             requires 'distilled_response_from_response';
421              
422             =head3 response_from_distilled_response
423              
424             In: $distilled_response (JSON-serialisable data)
425             Out: $response (HTTP::Response object or subclass)
426              
427             Passed the distilled response that, in a previous run of your test code when
428             the environment variable REGENERATE_MOCK_FILE was set, you generated from a
429             real-life HTTP::Response object (or a subclass thereof), you must return a
430             HTTP::Response (or subclass thereof) object that I will be
431             able to interpret reliably.
432              
433             Note the emphasis! It's OK to not bother returning all sorts of e.g. date,
434             crypto etc. headers if your code doesn't care about that stuff. You won't end
435             up replicating I the way a live system behaves, but if your code
436             doesn't care about that, why should you? Consider this an intersection of YAGNI
437             and Postel's Law.
438              
439             B, if your code behaves differently based on the HTTP code, you need to
440             set this. If, as in the extended example above, you have an encrypted thingy
441             returned from a login attempt, you need to populate the appropriate header.
442              
443             =cut
444              
445             requires 'response_from_distilled_response';
446              
447             =head2 Attributes supplied
448              
449             The following attributes are provided by Test::Mock::LWP::Distilled to your
450             class.
451              
452             =head3 mode
453              
454             Either C or C. By default determined by the environment
455             variable REGENERATE_MOCK_FILE: if set, the mode is C, otherwise the
456             mode is C.
457              
458             When recording, a request triggers a I request to the remote website; the
459             live response is returned to the calling code, and a new mock is recorded
460             from the distilled request and distilled response.
461              
462             When playing, a request triggers a check that the next unused mock's distilled
463             request is identical to the distilled version of the current request; if so,
464             the mock is marked as having been used, and a response is generated from the
465             distilled response in the mock.
466              
467             =cut
468              
469             has 'mode' => (
470             is => 'rw',
471             isa => Enum [qw(record play)],
472             default => sub {
473             $ENV{REGENERATE_MOCK_FILE} ? 'record' : 'play',
474             },
475             );
476              
477             =head3 base_dir
478              
479             The directory that mocks should be read from, and written to. You can pass this
480             as a constructor argument; if you set it later instead, you should make sure
481             it's set before any attempt to read mocks (play mode) or write mocks (record
482             mode).
483              
484             =cut
485              
486             has 'base_dir' => (
487             is => 'rw',
488             isa => sub { -d shift },
489             );
490              
491             =head3 file_name_from_calling_class
492              
493             Boolean. If set, we use the calling class to determine L
494             rather than the name of the test file. You can pass this as a constructor
495             argument.
496              
497             =cut
498              
499             has 'file_name_from_calling_class' => (
500             is => 'rw',
501             isa => Bool,
502             );
503              
504             =head3 mock_filename
505              
506             The filename we'll read mocks from, and write mocks to. This is determined
507             by concatenating L with either the version of your test file
508             (default) or the name of your calling class (if you set the
509             L attribute), as follows:
510              
511             =over
512              
513             =item file
514              
515             We take the filename of the file that built the mock object, and discard
516             anything before the last directory called C. So if you have code in
517             C,
518             we'll add to L, C.json>.
519              
520             =item class
521              
522             We take the name of the class which built the mock object and turn it into
523             a directory hierarchy. So for class C
524             we'll add to L,
525             C.json>.
526              
527             =back
528              
529             =cut
530              
531             # We said that we'd determine the filename based on how the object was built,
532             # so hook into that via BUILD, and find where our constructor was called.
533              
534             has ['_calling_package', '_calling_filename'] => (
535             is => 'rwp',
536             init_arg => undef,
537             );
538              
539             sub BUILD {
540 14     14 0 3430 my ($self) = @_;
541              
542 14         30 my $frame = 0;
543 14         24 my ($found_constructor, $package, $filename, $line, $subroutine);
544             frame:
545 14         40 while (!$found_constructor) {
546 28         297 ($package, $filename, $line, $subroutine) = caller($frame);
547 28 50       80 last frame if !$package;
548 28 100       70 if ($subroutine eq ref($self) . '::new') {
549 14         19 $found_constructor = 1;
550             }
551 28         57 $frame++;
552             }
553 14         45 $self->_set__calling_package($package);
554 14         91 $self->_set__calling_filename(Path::Class::File->new($filename)->absolute->stringify);
555             }
556              
557             has 'mock_filename' => (
558             is => 'lazy',
559             init_arg => undef,
560             );
561             sub _build_mock_filename {
562 11     11   1002 my ($self) = @_;
563              
564             # We need a base directory before we can do anything.
565 11 50       153 $self->base_dir or Carp::confess 'No base directory provided!';
566              
567             # We'll tack on any number of additional directories, and then use the
568             # last part of either the calling filename or the calling class as the
569             # leafname for the mock file, to which we'll add our class-defined suffix
570             # and a .json extension.
571 11         93 my (@additional_file_paths, $leafname);
572 11 100       153 if ($self->file_name_from_calling_class) {
573 8         69 my @class_name_components = split /::/, $self->_calling_package;
574 8         16 $leafname = pop @class_name_components;
575 8         31 @additional_file_paths = @class_name_components;
576             } else {
577 3         43 my $calling_file = Path::Class::File->new($self->_calling_filename);
578 3         247 my @file_components = $calling_file->components;
579 3         81 $leafname = pop @file_components;
580 3   66     48 while (@file_components && $file_components[-1] ne 't') {
581 4         16 unshift @additional_file_paths, pop @file_components;
582             }
583             }
584              
585             # Use Path::Class to generate hopefully a platform-independent filename.
586 11         168 my $mock_directory = Path::Class::Dir->new($self->base_dir);
587 11 100       487 if (@additional_file_paths) {
588 9         23 $mock_directory = $mock_directory->subdir(@additional_file_paths);
589             }
590 11         433 $leafname =~ s/[.].+$//;
591 11         50 my $mock_file = Path::Class::File->new($mock_directory,
592             $leafname . '-' . $self->filename_suffix . '.json');
593 11         733 return $mock_file->stringify;
594             }
595              
596             =head3 mocks
597              
598             An arrayref of mock hashrefs, each of which contain the keys
599             C and C.
600              
601             =cut
602              
603             has 'mocks' => (
604             is => 'lazy',
605             isa => ArrayRef [HashRef],
606             init_arg => undef,
607             );
608              
609             sub _build_mocks {
610 10     10   2693 my ($self) = @_;
611              
612             # If we're recording, we start out with empty mocks as regardless of
613             # whether there *were* mocks in a file somewhere, we're going to be
614             # replacing them.
615 10 100       149 if ($self->mode eq 'record') {
616 5         90 return [];
617             }
618              
619             # If we don't have a mock filename, that might cause us problems later on
620             # if we try to use them, but it's not inherently a problem.
621 5 100       126 if (!-e $self->mock_filename) {
622 1         99 return [];
623             }
624            
625             # OK, try to read from our file...
626 4         220 my $jsonifier = JSON::MaybeXS->new(utf8 => 0);
627 1 50   1   75 open my $fh, '<:encoding(UTF-8)', $self->mock_filename
  1         3  
  1         17  
  4         180  
628             or die sprintf(q{Couldn't read from %s: %s},
629             $self->mock_filename, $OS_ERROR);
630              
631             # ...decode it...
632 4         1959 my $json;
633 4         7 { local $/ = undef; $json = <$fh>; }
  4         15  
  4         109  
634 4         62 my $json_data;
635 4 100       8 eval { $json_data = $jsonifier->decode($json); 1 }
  4         97  
  3         9  
636             or die sprintf('Invalid JSON? Reading from file %s gave error %s',
637             $self->mock_filename, $EVAL_ERROR);
638              
639             # ...and check it looks the part.
640 3 100       10 if (ref($json_data) ne 'ARRAY') {
641 1         28 die sprintf('Expected an arrayref of data from %s, got %s instead',
642             $self->mock_filename, $json_data);
643             }
644 2 100       5 if (
645             grep {
646             ref($_) ne 'HASH'
647             || !exists $_->{distilled_request}
648             || !exists $_->{distilled_response}
649 4 100 66     34 } @$json_data
650             )
651             {
652 1         34 die sprintf('At least one of the items in the mock data from %s'
653             . ' did not contain distilled_request and distilled_response',
654             $self->mock_filename);
655             }
656              
657 1         47 return $json_data;
658             }
659              
660             sub DEMOLISH {
661 14     14 0 16988 my ($self) = @_;
662              
663             # Obviously there's nothing to be done if we don't have any mocks to
664             # record.
665 14 100 100     188 return unless $self->mode eq 'record' && @{ $self->mocks };
  5         93  
666              
667             # Write our mocks to our chosen mock file.
668 3 100       77 open my $fh, '>:encoding(UTF-8)', $self->mock_filename
669             or die sprintf('Tried writing mocks to %s but failed: %s',
670             $self->mock_filename, $OS_ERROR
671             );
672 2         294 my $jsonifier = JSON::MaybeXS->new(utf8 => 0, pretty => 1, canonical => 1);
673 2         45 my $json;
674 2 100       5 eval { $json = $jsonifier->encode($self->mocks); 1 }
  2         41  
  1         21  
675             or die q{Couldn't encode mocks as JSON: } . $EVAL_ERROR;
676 1 50       15 print $fh $json or die sprintf(
677             q{Couldn't write mocks as JSON to %s: %s},
678             $self->mock_filename, $OS_ERROR
679             );
680 1 50       67 close $fh or die sprintf(
681             q{Baffingly, couldn't close file %s: %s},
682             $self->mock_filename, $OS_ERROR
683             );
684            
685             }
686              
687             =head2 Methods supplied
688              
689             =head3 simple_request
690              
691             As per LWP::UserAgent::simple_request, but:
692              
693             =over
694              
695             =item In record mode
696              
697             It calls the original simple_request method, and records the distilled request
698             and distilled response as new mocks
699              
700             =item In play mode
701              
702             It looks for the next unused mock, checks that its distilled request matches
703             the distilled version of the supplied request, and if so returns a response
704             generated from the distilled response in the mock. Otherwise dies with an
705             exception.
706              
707             =back
708              
709             =cut
710              
711             # Explicitly support monkey-patching because the way around works involves
712             # lexical variables that we can't get access to afterwards.
713             # The presence of %Class::Method::Modifiers::MODIFIER_CACHE is
714             # misleading: it doesn't include a reference to $orig, which is what we
715             # want to monkey-patch, so we have to monkey-patch explicitly.
716             has '_monkey_patched_simple_request' => (
717             is => 'rw',
718             isa => CodeRef,
719             );
720              
721             around simple_request => sub {
722             my ($orig, $self, $request, $arg, $size) = @_;
723              
724             # For testing purposes we want to let people override the original
725             # method, but don't use this in production!
726             if ($self->_monkey_patched_simple_request && $ENV{HARNESS_ACTIVE}) {
727             $orig = $self->_monkey_patched_simple_request;
728             }
729              
730             if ($self->mode eq 'record') {
731             my $response = $self->$orig($request, $arg, $size);
732             push @{ $self->mocks }, {
733             distilled_request =>
734             $self->distilled_request_from_request($request),
735             distilled_response =>
736             $self->distilled_response_from_response($response),
737             };
738             return $response;
739             } else {
740             # Go looking for mocks we could use.
741             my @possible_mocks = @{ $self->mocks };
742             while (@possible_mocks && $possible_mocks[0]{used}) {
743             shift @possible_mocks;
744             }
745             if (!@possible_mocks) {
746             Carp::confess('No mocks left to use');
747             }
748              
749             # The first mock had better match.
750             my $distilled_request = $self->distilled_request_from_request($request);
751             if (Data::Compare::Compare(
752             $distilled_request,
753             $possible_mocks[0]{distilled_request}
754             ))
755             {
756             $possible_mocks[0]{used}++;
757             return $self->response_from_distilled_response(
758             $possible_mocks[0]{distilled_response}
759             );
760             } else {
761             local $Data::Dumper::Indent = 1;
762             local $Data::Dumper::Sortkeys = 1;
763             local $Data::Dumper::Terse = 1;
764             Carp::confess(
765             sprintf(
766             "Request does not match the first available mock:\n"
767             . "Distilled request: %s\nFirst-available mock: %s\n",
768             Dumper($distilled_request),
769             Dumper($possible_mocks[0]{distilled_request})
770             )
771             );
772             }
773             }
774             };
775              
776             =head1 SEE ALSO
777              
778             L, L, L,
779             L, and almost certainly others.
780              
781             =head1 AUTHOR
782              
783             Sam Kington
784              
785             The source code for this module is hosted on GitHub
786             L - this is probably the
787             best place to look for suggestions and feedback.
788              
789             =head1 COPYRIGHT
790              
791             Copyright L 2021.
792              
793             =head1 LICENSE
794              
795             This library is free software and may be distributed under the same terms as
796             perl itself.
797              
798             =cut
799              
800             1;