Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Test; |
2 | |
e8d0f69a |
3 | use Test::More; |
4 | |
fc7ec1d9 |
5 | use strict; |
b39840da |
6 | use warnings; |
d837e1a7 |
7 | |
a2f2cde9 |
8 | use Catalyst::Exception; |
d837e1a7 |
9 | use Catalyst::Utils; |
16d306fa |
10 | use Class::Inspector; |
0f895006 |
11 | |
e8d0f69a |
12 | use parent qw/Exporter/; |
13 | our @EXPORT=qw/&content_like &action_ok &action_redirect &action_notfound &contenttype_is/; |
14 | |
15 | |
fc7ec1d9 |
16 | =head1 NAME |
17 | |
8d2fa70c |
18 | Catalyst::Test - Test Catalyst Applications |
fc7ec1d9 |
19 | |
20 | =head1 SYNOPSIS |
21 | |
49faa307 |
22 | # Helper |
49faa307 |
23 | script/test.pl |
24 | |
fc7ec1d9 |
25 | # Tests |
26 | use Catalyst::Test 'TestApp'; |
27 | request('index.html'); |
28 | get('index.html'); |
29 | |
2f381252 |
30 | use HTTP::Request::Common; |
31 | my $response = request POST '/foo', [ |
32 | bar => 'baz', |
33 | something => 'else' |
34 | ]; |
35 | |
45374ac6 |
36 | # Run tests against a remote server |
21465c88 |
37 | CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/ |
45374ac6 |
38 | |
b6898a9f |
39 | # Tests with inline apps need to use Catalyst::Engine::Test |
40 | package TestApp; |
41 | |
8d2fa70c |
42 | use Catalyst; |
b6898a9f |
43 | |
c46c32fa |
44 | sub foo : Global { |
b6898a9f |
45 | my ( $self, $c ) = @_; |
46 | $c->res->output('bar'); |
c46c32fa |
47 | } |
48 | |
49 | __PACKAGE__->setup(); |
b6898a9f |
50 | |
51 | package main; |
52 | |
b6898a9f |
53 | use Catalyst::Test 'TestApp'; |
e8d0f69a |
54 | use Test::More tests => 1; |
b6898a9f |
55 | |
56 | ok( get('/foo') =~ /bar/ ); |
57 | |
fc7ec1d9 |
58 | =head1 DESCRIPTION |
59 | |
2f381252 |
60 | This module allows you to make requests to a Catalyst application either without |
61 | a server, by simulating the environment of an HTTP request using |
62 | L<HTTP::Request::AsCGI> or remotely if you define the CATALYST_SERVER |
e8d0f69a |
63 | environment variable. This module also adds a few catalyst |
64 | specific testing methods as displayed in the method section. |
2f381252 |
65 | |
66 | The </get> and </request> functions take either a URI or an L<HTTP::Request> |
67 | object. |
fc7ec1d9 |
68 | |
69 | =head2 METHODS |
70 | |
b5ecfcf0 |
71 | =head2 get |
fc7ec1d9 |
72 | |
73 | Returns the content. |
74 | |
75 | my $content = get('foo/bar?test=1'); |
76 | |
f13fc03f |
77 | Note that this method doesn't follow redirects, so to test for a |
78 | correctly redirecting page you'll need to use a combination of this |
79 | method and the L<request> method below: |
80 | |
81 | my $res = request('/'); # redirects to /y |
82 | warn $res->header('location'); |
83 | use URI; |
84 | my $uri = URI->new($res->header('location')); |
85 | is ( $uri->path , '/y'); |
86 | my $content = get($uri->path); |
87 | |
b5ecfcf0 |
88 | =head2 request |
fc7ec1d9 |
89 | |
90 | Returns a C<HTTP::Response> object. |
91 | |
795117cf |
92 | my $res = request('foo/bar?test=1'); |
fc7ec1d9 |
93 | |
94 | =cut |
95 | |
fc7ec1d9 |
96 | sub import { |
66d9e175 |
97 | my $self = shift; |
45374ac6 |
98 | my $class = shift; |
99 | |
100 | my ( $get, $request ); |
101 | |
d96e14c2 |
102 | if ( $ENV{CATALYST_SERVER} ) { |
45374ac6 |
103 | $request = sub { remote_request(@_) }; |
104 | $get = sub { remote_request(@_)->content }; |
fb02aed1 |
105 | } elsif (! $class) { |
106 | $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") }; |
107 | $get = $request; |
108 | } else { |
16d306fa |
109 | unless( Class::Inspector->loaded( $class ) ) { |
1e514a51 |
110 | require Class::Inspector->filename( $class ); |
af81c980 |
111 | } |
d96e14c2 |
112 | $class->import; |
113 | |
0f895006 |
114 | $request = sub { local_request( $class, @_ ) }; |
115 | $get = sub { local_request( $class, @_ )->content }; |
49faa307 |
116 | } |
45374ac6 |
117 | |
118 | no strict 'refs'; |
119 | my $caller = caller(0); |
120 | *{"$caller\::request"} = $request; |
121 | *{"$caller\::get"} = $get; |
e8d0f69a |
122 | __PACKAGE__->export_to_level(1); |
45374ac6 |
123 | } |
124 | |
b5ecfcf0 |
125 | =head2 local_request |
0f895006 |
126 | |
2f381252 |
127 | Simulate a request using L<HTTP::Request::AsCGI>. |
128 | |
0f895006 |
129 | =cut |
130 | |
131 | sub local_request { |
132 | my $class = shift; |
133 | |
134 | require HTTP::Request::AsCGI; |
135 | |
136 | my $request = Catalyst::Utils::request( shift(@_) ); |
137 | my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup; |
138 | |
139 | $class->handle_request; |
140 | |
141 | return $cgi->restore->response; |
142 | } |
143 | |
523d44ec |
144 | my $agent; |
145 | |
b5ecfcf0 |
146 | =head2 remote_request |
bea4160a |
147 | |
b77e7869 |
148 | Do an actual remote request using LWP. |
bea4160a |
149 | |
150 | =cut |
151 | |
45374ac6 |
152 | sub remote_request { |
45374ac6 |
153 | |
68eb5874 |
154 | require LWP::UserAgent; |
155 | |
d837e1a7 |
156 | my $request = Catalyst::Utils::request( shift(@_) ); |
0f895006 |
157 | my $server = URI->new( $ENV{CATALYST_SERVER} ); |
523d44ec |
158 | |
159 | if ( $server->path =~ m|^(.+)?/$| ) { |
890e8d18 |
160 | my $path = $1; |
161 | $server->path("$path") if $path; # need to be quoted |
f4c0f6f7 |
162 | } |
cdae055a |
163 | |
164 | # the request path needs to be sanitised if $server is using a |
165 | # non-root path due to potential overlap between request path and |
166 | # response path. |
167 | if ($server->path) { |
f4c0f6f7 |
168 | # If request path is '/', we have to add a trailing slash to the |
169 | # final request URI |
170 | my $add_trailing = $request->uri->path eq '/'; |
171 | |
cdae055a |
172 | my @sp = split '/', $server->path; |
173 | my @rp = split '/', $request->uri->path; |
174 | shift @sp;shift @rp; # leading / |
175 | if (@rp) { |
176 | foreach my $sp (@sp) { |
a7daf37e |
177 | $sp eq $rp[0] ? shift @rp : last |
cdae055a |
178 | } |
179 | } |
180 | $request->uri->path(join '/', @rp); |
f4c0f6f7 |
181 | |
182 | if ( $add_trailing ) { |
183 | $request->uri->path( $request->uri->path . '/' ); |
184 | } |
523d44ec |
185 | } |
186 | |
187 | $request->uri->scheme( $server->scheme ); |
188 | $request->uri->host( $server->host ); |
189 | $request->uri->port( $server->port ); |
190 | $request->uri->path( $server->path . $request->uri->path ); |
191 | |
68eb5874 |
192 | unless ($agent) { |
9ffadf88 |
193 | |
d837e1a7 |
194 | $agent = LWP::UserAgent->new( |
523d44ec |
195 | keep_alive => 1, |
196 | max_redirect => 0, |
197 | timeout => 60, |
198 | ); |
d837e1a7 |
199 | |
523d44ec |
200 | $agent->env_proxy; |
201 | } |
45374ac6 |
202 | |
203 | return $agent->request($request); |
fc7ec1d9 |
204 | } |
205 | |
e8d0f69a |
206 | =head2 action_ok |
207 | |
208 | Fetches the given url and check that the request was successful |
209 | |
210 | =head2 action_redirect |
211 | |
212 | Fetches the given url and check that the request was a redirect |
213 | |
214 | =head2 action_notfound |
215 | |
216 | Fetches the given url and check that the request was not found |
217 | |
218 | =head2 content_like |
219 | |
220 | Fetches the given url and matches the content against it. |
221 | |
222 | =head2 contenttype_is |
223 | |
224 | Check for given mime type |
225 | |
226 | =cut |
227 | |
228 | sub content_like { |
229 | my $caller=caller(0); |
230 | no strict 'refs'; |
231 | my $get=*{"$caller\::get"}; |
232 | my $action=shift; |
6cf9bf47 |
233 | return Test::More->builder->like(&$get($action),@_); |
e8d0f69a |
234 | } |
235 | |
236 | sub action_ok { |
237 | my $caller=caller(0); |
238 | no strict 'refs'; |
239 | my $request=*{"$caller\::request"}; |
240 | my $action=shift; |
241 | return Test::More->builder->ok(&$request($action)->is_success, @_); |
242 | } |
243 | |
244 | sub action_redirect { |
245 | my $caller=caller(0); |
246 | no strict 'refs'; |
247 | my $request=*{"$caller\::request"}; |
248 | my $action=shift; |
249 | return Test::More->builder->ok(&$request($action)->is_redirect,@_); |
250 | |
251 | } |
252 | |
253 | sub action_notfound { |
254 | my $caller=caller(0); |
255 | no strict 'refs'; |
256 | my $request=*{"$caller\::request"}; |
257 | my $action=shift; |
258 | return Test::More->builder->is_eq(&$request($action)->code,404,@_); |
259 | |
260 | } |
261 | |
262 | |
263 | sub contenttype_is { |
264 | my $caller=caller(0); |
265 | no strict 'refs'; |
266 | my $request=*{"$caller\::request"}; |
267 | my $action=shift; |
268 | my $res=&$request($action); |
269 | return Test::More->builder->is_eq(scalar($res->content_type),@_); |
270 | } |
271 | |
fc7ec1d9 |
272 | =head1 SEE ALSO |
273 | |
2f381252 |
274 | L<Catalyst>, L<Test::WWW::Mechanize::Catalyst>, |
275 | L<Test::WWW::Selenium::Catalyst>, L<Test::More>, L<HTTP::Request::Common> |
fc7ec1d9 |
276 | |
2f381252 |
277 | =head1 AUTHORS |
fc7ec1d9 |
278 | |
2f381252 |
279 | Catalyst Contributors, see Catalyst.pm |
fc7ec1d9 |
280 | |
281 | =head1 COPYRIGHT |
282 | |
283 | This program is free software, you can redistribute it and/or modify it under |
284 | the same terms as Perl itself. |
285 | |
286 | =cut |
287 | |
288 | 1; |