File Coverage

blib/lib/Plack/Test/Agent.pm
Criterion Covered Total %
statement 89 92 96.7
branch 19 22 86.3
condition 6 11 54.5
subroutine 21 22 95.4
pod 7 7 100.0
total 142 154 92.2


line stmt bran cond sub pod time code
1             package Plack::Test::Agent;
2             our $VERSION = '1.5';
3 8     8   911954 use strict;
  8         93  
  8         238  
4 8     8   46 use warnings;
  8         19  
  8         210  
5              
6 8     8   3990 use Test::TCP;
  8         594643  
  8         655  
7 8     8   4211 use Plack::Loader;
  8         56688  
  8         240  
8 8     8   4336 use HTTP::Response;
  8         217561  
  8         317  
9 8     8   3923 use HTTP::Message::PSGI;
  8         14604  
  8         463  
10 8     8   4183 use HTTP::Request::Common;
  8         31021  
  8         547  
11 8     8   5429 use Test::WWW::Mechanize;
  8         1087189  
  8         416  
12 8     8   4641 use HTTP::Cookies;
  8         60404  
  8         341  
13              
14 8     8   3793 use Plack::Util::Accessor qw( app host port server ua jar );
  8         2268  
  8         62  
15              
16             sub new {
17 10     10 1 13091 my ( $class, %args ) = @_;
18              
19 10         109 my $self = bless {}, $class;
20              
21 10         76 $self->app( delete $args{app} );
22 10         152 $self->ua( delete $args{ua} );
23 10   50     161 $self->host( delete $args{host} || 'localhost' );
24 10         88 $self->port( delete $args{port} );
25 10   33     143 $self->jar( delete $args{jar} || HTTP::Cookies->new );
26              
27 10 100       361 $self->start_server( delete $args{server} ) if $args{server};
28              
29 10         254 return $self;
30             }
31              
32             sub start_server {
33 6     6 1 24 my ( $self, $server_class ) = @_;
34              
35 6         17 my $app = $self->app;
36 6         35 my $host = $self->host;
37              
38             my $server = Test::TCP->new(
39             code => sub {
40 0     0   0 my $port = shift;
41 0         0 my %args = ( host => $host, port => $port );
42 0 0       0 return $server_class
43             ? Plack::Loader->load( $server_class, %args )->run($app)
44             : Plack::Loader->auto(%args)->run($app);
45             },
46 6         78 );
47              
48 6         210936 $self->port( $server->port );
49 6 50       409 $self->ua( $self->get_mech ) unless $self->ua;
50 6         76 $self->server($server);
51             }
52              
53             sub execute_request {
54 15     15 1 40 my ( $self, $req ) = @_;
55              
56 15 100 66     53 if ( !$self->server && $self->jar ) {
57 8         126 $self->jar->add_cookie_header($req);
58             }
59              
60 15 100       2509 my $res
61             = $self->server
62             ? $self->ua->request($req)
63             : HTTP::Response->from_psgi( $self->app->( $req->to_psgi ) );
64              
65 15         190694 $res->request($req);
66              
67 15 100 66     346 if ( !$self->server && $self->jar ) {
68 8         129 $self->jar->extract_cookies($res);
69             }
70              
71 15         1540 return $res;
72             }
73              
74             sub get {
75 13     13 1 16341 my ( $self, $uri, @args ) = @_;
76 13         47 my $req = GET $self->normalize_uri($uri), @args;
77 13         2198 return $self->execute_request($req);
78             }
79              
80             sub post {
81 2     2 1 7650 my ( $self, $uri, @args ) = @_;
82 2         8 my $req = POST $self->normalize_uri($uri), @args;
83 2         977 return $self->execute_request($req);
84             }
85              
86             sub normalize_uri {
87 23     23 1 135 my ( $self, $uri ) = @_;
88 23         406 my $normalized = URI->new($uri);
89 23         59834 my $port = $self->port;
90              
91 23 100       467 $normalized->scheme('http') unless $normalized->scheme;
92 23 100       29353 $normalized->host('localhost') unless $normalized->host;
93 23 100       3198 $normalized->port($port) if $port;
94              
95 23         1481 return $normalized;
96             }
97              
98             sub get_mech {
99 8     8 1 4900 my $self = shift;
100 8         456 return Test::WWW::Mechanize::Bound->new(
101             bound_uri => $self->normalize_uri('/') );
102             }
103              
104             package Test::WWW::Mechanize::Bound;
105             our $VERSION = '1.5';
106 8     8   6148 use parent 'Test::WWW::Mechanize';
  8         29  
  8         62  
107              
108             sub new {
109 8     8   129 my ( $class, %args ) = @_;
110 8         28 my $bound_uri = delete $args{bound_uri};
111 8         293 my $self = $class->SUPER::new(%args);
112 8         55453 $self->bound_uri($bound_uri);
113 8         123 return $self;
114             }
115              
116             sub bound_uri {
117 19     19   60 my ( $self, $base_uri ) = @_;
118 19 100       91 $self->_elem( bound_uri => $base_uri ) if @_ == 2;
119 19         140 return $self->_elem('bound_uri');
120             }
121              
122             sub prepare_request {
123 11     11   69775 my $self = shift;
124 11         30 my ($req) = @_;
125 11         58 my $uri = $req->uri;
126 11         121 my $base = $self->bound_uri;
127              
128 11 100       122 unless ( $uri->scheme ) {
129 1         20 $uri->scheme( $base->scheme );
130 1         94 $uri->host( $base->host );
131 1         133 $uri->port( $base->port );
132             }
133 11         378 return $self->SUPER::prepare_request(@_);
134             }
135              
136             1;
137              
138             =pod
139              
140             =head1 NAME
141              
142             Plack::Test::Agent - OO interface for testing low-level Plack/PSGI apps
143              
144             =head1 VERSION
145              
146             version 1.5
147              
148             =encoding utf-8
149              
150             =head2 SYNOPSIS
151              
152             use Test::More;
153             use Plack::Test::Agent;
154              
155             my $app = sub { ... };
156             my $local_agent = Plack::Test::Agent->new( app => $app );
157             my $server_agent = Plack::Test::Agent->new(
158             app => $app,
159             server => 'HTTP::Server::Simple' );
160              
161             my $local_res = $local_agent->get( '/' );
162             my $server_res = $server_agent->get( '/' );
163              
164             ok $local_res->is_success, 'local GET / should succeed';
165             ok $server_res->is_success, 'server GET / should succeed';
166              
167             =head2 DESCRIPTION
168              
169             C<Plack::Test::Agent> is an OO interface to test PSGI applications. It can
170             perform GET and POST requests against PSGI applications either in process or
171             over HTTP through a L<Plack::Handler> compatible backend.
172              
173             B<NOTE:> This is an experimental module and its interface may change.
174              
175             =head2 CONSTRUCTION
176              
177             =head3 C<new>
178              
179             The C<new> constructor creates an instance of C<Plack::Test::Agent>. This
180             constructor takes one mandatory named argument and several optional arguments.
181              
182             =over 4
183              
184             =item * C<app> is the mandatory argument. You must provide a PSGI application
185             to test.
186              
187             =item * C<server> is an optional argument. When provided, C<Plack::Test::Agent>
188             will attempt to start a PSGI handler and will communicate via HTTP to the
189             application running through the handler. See L<Plack::Loader> for details on
190             selecting the appropriate server.
191              
192             =item * C<host> is an optional argument representing the name or IP address for
193             the server to use. The default is C<localhost>.
194              
195             =item * C<port> is an optional argument representing the TCP port to for the
196             server to use. If not provided, the service will run on a randomly selected
197             available port outside of the IANA reserved range. (See L<Test::TCP> for
198             details on the selection of the port number.)
199              
200             =item * C<ua> is an optional argument of something which conforms to the
201             L<LWP::UserAgent> interface such that it provides a C<request> method which
202             takes an L<HTTP::Request> object and returns an L<HTTP::Response> object. The
203             default is an instance of C<LWP::UserAgent>.
204              
205             =item * C<jar> is an optional argument for a L<HTTP::Cookies> instance that
206             will be used as cookie jar for the requests, by default plain one is created.
207              
208             =back
209              
210             =head2 METHODS
211              
212             This class provides several useful methods:
213              
214             =head3 C<get>
215              
216             This method takes a URI and makes a C<GET> request against the PSGI application
217             with that URI. It returns an L<HTTP::Response> object representing the results
218             of that request.
219              
220             =head3 C<post>
221              
222             This method takes a URI and makes a C<POST> request against the PSGI
223             application with that URI. It returns an L<HTTP::Response> object representing
224             the results of that request. As an optional second parameter, pass an array
225             reference of key/value pairs for the form content:
226              
227             $agent->post( '/edit_user',
228             [
229             shoe_size => '10.5',
230             eye_color => 'blue green',
231             status => 'twin',
232             ]);
233              
234             =head3 C<execute_request>
235              
236             This method takes an L<HTTP::Request>, performs it against the bound app, and
237             returns an L<HTTP::Response>. This allows you to craft your own requests
238             directly.
239              
240             =head3 C<get_mech>
241              
242             Used internally to create a default UserAgent, if none is provided to the
243             constructor. Returns a Test::WWW::Mechanize::Bound object.
244              
245             =head3 C<normalize_uri>
246              
247             Used internally to ensure that all requests use the correct scheme, host and
248             port. The scheme and host default to C<http> and C<localhost> respectively,
249             while the port is determined by L<Test::TCP>.
250              
251             =head3 C<start_server>
252              
253             Starts a test server via L<Test::TCP>. If a C<server> arg has been provided to
254             the constructor, it will use this class to load a server. Defaults to letting
255             Plack::Loader decide which server class to use.
256              
257             =head2 CREDITS
258              
259             Thanks to Zbigniew E<0x141>ukasiak and Tatsuhiko Miyagawa for suggestions.
260              
261             =head1 AUTHORS
262              
263             =over 4
264              
265             =item *
266              
267             chromatic <chromatic@wgz.org>
268              
269             =item *
270              
271             Dave Rolsky <autarch@urth.org>
272              
273             =item *
274              
275             Ran Eilam <ran.eilam@gmail.com>
276              
277             =item *
278              
279             Olaf Alders <olaf@wundercounter.com>
280              
281             =back
282              
283             =head1 CONTRIBUTORS
284              
285             =for stopwords Dave Rolsky Olaf Alders Ran Eilam Syohei YOSHIDA Torsten Raudssus
286              
287             =over 4
288              
289             =item *
290              
291             Dave Rolsky <drolsky@maxmind.com>
292              
293             =item *
294              
295             Olaf Alders <oalders@maxmind.com>
296              
297             =item *
298              
299             Ran Eilam <reilam@maxmind.com>
300              
301             =item *
302              
303             Syohei YOSHIDA <syohex@gmail.com>
304              
305             =item *
306              
307             Torsten Raudssus <torsten@raudss.us>
308              
309             =back
310              
311             =head1 COPYRIGHT AND LICENSE
312              
313             This software is copyright (c) 2011 by chromatic.
314              
315             This is free software; you can redistribute it and/or modify it under
316             the same terms as the Perl 5 programming language system itself.
317              
318             =cut
319              
320             __END__
321              
322              
323             # ABSTRACT: OO interface for testing low-level Plack/PSGI apps