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