File Coverage

blib/lib/Test/Mock/LWP.pm
Criterion Covered Total %
statement 23 25 92.0
branch 3 8 37.5
condition n/a
subroutine 5 5 100.0
pod n/a
total 31 38 81.5


line stmt bran cond sub pod time code
1             package Test::Mock::LWP;
2 1     1   23155 use strict;
  1         3  
  1         45  
3 1     1   5 use warnings;
  1         2  
  1         31  
4 1     1   5 use base 'Exporter';
  1         6  
  1         115  
5 1     1   951 use Test::MockObject;
  1         3674  
  1         7  
6             our @EXPORT = qw($Mock_ua $Mock_req $Mock_request $Mock_resp $Mock_response);
7              
8             =head1 NAME
9              
10             Test::Mock::LWP - Easy mocking of LWP packages
11              
12             =cut
13              
14             =head1 SYNOPSIS
15              
16             Make LWP packages to make testing easier.
17              
18             use Test::Mock::LWP;
19              
20             # Setup fake response content and code
21             $Mock_response->mock( content => sub { 'foo' } );
22             $Mock_resp->mock( code => sub { 201 } );
23              
24             # Validate args passed to request constructor
25             is_deeply $Mock_request->new_args, \@expected_args;
26            
27             # Validate request headers
28             is_deeply [ $Mock_req->next_call ],
29             [ 'header', [ 'Accept', 'text/plain' ] ];
30              
31             # Special User Agent Behaviour
32             $Mock_ua->mock( request => sub { die 'foo' } );
33              
34             =head1 DESCRIPTION
35              
36             This package arises from duplicating the same code to mock LWP et al in
37             several different modules I've written. This version is very minimalist, but
38             works for my needs so far. I'm very open to new suggestions and improvements.
39              
40             =head1 EXPORTS
41              
42             The following variables are exported by default:
43              
44             =over 4
45              
46             =item $Mock_ua
47              
48             The mock LWP::UserAgent object - a Test::MockObject object
49              
50             =item $Mock_req, $Mock_request
51              
52             The mock HTTP::Request object - a Test::MockObject object
53              
54             =item $Mock_resp, $Mock_response
55              
56             The mock HTTP::Response object - a Test::MockObject object
57              
58             =back
59              
60             =cut
61              
62             our $VERSION = '0.08';
63              
64             BEGIN {
65             # Don't load the mock classes if the real ones are already loaded
66 1     1   250 my $mo = Test::MockObject->new;
67 1         12 my @mock_classes = (
68             [ 'HTTP::Response' => '$Mock_response $Mock_resp' ],
69             [ 'HTTP::Request' => '$Mock_request $Mock_req' ],
70             [ 'LWP::UserAgent' => '$Mock_ua' ],
71             );
72 1         8 for my $c (@mock_classes) {
73 3         7 my ($real, $imports) = @$c;
74 3 50       12 if (!$mo->check_class_loaded($real)) {
75 3         57 my $mock_class = "Test::Mock::$real";
76 3         172 eval "require $mock_class";
77 3 50       18 if ($@) {
78 0 0       0 warn "error during require $mock_class: $@" if $@;
79 0         0 next;
80             }
81 3         9 my $import = "$mock_class qw($imports)";
82 3         183 eval "import $import";
83 3 50       23 warn "error during import $import: $@" if $@;
84             }
85             }
86             }
87              
88             =head1 AUTHOR
89              
90             Luke Closs, C<< >>
91              
92             =head1 BUGS
93              
94             Please report any bugs or feature requests through the web interface at
95             L.
96             I will be notified, and then you'll automatically be notified of progress on
97             your bug as I make changes.
98              
99             =head1 SUPPORT
100              
101             You can find documentation for this module with the perldoc command.
102              
103             perldoc Test::Mock::LWP
104              
105             You can also look for information at:
106              
107             =over 4
108              
109             =item * AnnoCPAN: Annotated CPAN documentation
110              
111             L
112              
113             =item * CPAN Ratings
114              
115             L
116              
117             =item * RT: CPAN's request tracker
118              
119             L
120              
121             =item * Search CPAN
122              
123             L
124              
125             =back
126              
127             =head1 ACKNOWLEDGEMENTS
128              
129             =head1 COPYRIGHT & LICENSE
130              
131             Copyright 2006 Luke Closs, all rights reserved.
132              
133             This program is free software; you can redistribute it and/or modify it
134             under the same terms as Perl itself.
135              
136             =cut
137              
138             1;