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