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 |