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