Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Test; |
2 | |
3 | use strict; |
b39840da |
4 | use warnings; |
d837e1a7 |
5 | |
a2f2cde9 |
6 | use Catalyst::Exception; |
d837e1a7 |
7 | use Catalyst::Utils; |
16d306fa |
8 | use Class::Inspector; |
0f895006 |
9 | |
fc7ec1d9 |
10 | =head1 NAME |
11 | |
8d2fa70c |
12 | Catalyst::Test - Test Catalyst Applications |
fc7ec1d9 |
13 | |
14 | =head1 SYNOPSIS |
15 | |
49faa307 |
16 | # Helper |
49faa307 |
17 | script/test.pl |
18 | |
fc7ec1d9 |
19 | # Tests |
20 | use Catalyst::Test 'TestApp'; |
26dd6d9f |
21 | my $content = get('index.html'); # Content as string |
22 | my $response = request('index.html'); # HTTP::Response object |
f2e13bbd |
23 | my($res, $c) = ctx_request('index.html'); # HTTP::Response & context object |
fc7ec1d9 |
24 | |
7ef58180 |
25 | use HTTP::Request::Common; |
26 | my $response = request POST '/foo', [ |
27 | bar => 'baz', |
28 | something => 'else' |
29 | ]; |
30 | |
45374ac6 |
31 | # Run tests against a remote server |
21465c88 |
32 | CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/ |
45374ac6 |
33 | |
b6898a9f |
34 | # Tests with inline apps need to use Catalyst::Engine::Test |
35 | package TestApp; |
36 | |
8d2fa70c |
37 | use Catalyst; |
b6898a9f |
38 | |
c46c32fa |
39 | sub foo : Global { |
b6898a9f |
40 | my ( $self, $c ) = @_; |
41 | $c->res->output('bar'); |
c46c32fa |
42 | } |
43 | |
44 | __PACKAGE__->setup(); |
b6898a9f |
45 | |
46 | package main; |
47 | |
48 | use Test::More tests => 1; |
49 | use Catalyst::Test 'TestApp'; |
50 | |
51 | ok( get('/foo') =~ /bar/ ); |
52 | |
fc7ec1d9 |
53 | =head1 DESCRIPTION |
54 | |
7ef58180 |
55 | This module allows you to make requests to a Catalyst application either without |
56 | a server, by simulating the environment of an HTTP request using |
57 | L<HTTP::Request::AsCGI> or remotely if you define the CATALYST_SERVER |
58 | environment variable. |
59 | |
60 | The </get> and </request> functions take either a URI or an L<HTTP::Request> |
61 | object. |
fc7ec1d9 |
62 | |
63 | =head2 METHODS |
64 | |
26dd6d9f |
65 | =head2 $content = get( ... ) |
fc7ec1d9 |
66 | |
67 | Returns the content. |
68 | |
69 | my $content = get('foo/bar?test=1'); |
70 | |
f13fc03f |
71 | Note that this method doesn't follow redirects, so to test for a |
72 | correctly redirecting page you'll need to use a combination of this |
73 | method and the L<request> method below: |
74 | |
75 | my $res = request('/'); # redirects to /y |
76 | warn $res->header('location'); |
77 | use URI; |
78 | my $uri = URI->new($res->header('location')); |
79 | is ( $uri->path , '/y'); |
80 | my $content = get($uri->path); |
81 | |
26dd6d9f |
82 | =head2 $res = request( ... ); |
fc7ec1d9 |
83 | |
84 | Returns a C<HTTP::Response> object. |
85 | |
795117cf |
86 | my $res = request('foo/bar?test=1'); |
fc7ec1d9 |
87 | |
26dd6d9f |
88 | =head1 FUNCTIONS |
89 | |
f2e13bbd |
90 | =head2 ($res, $c) = ctx_request( ... ); |
26dd6d9f |
91 | |
92 | Works exactly like C<Catalyst::Test::request>, except it also returns the |
93 | catalyst context object, C<$c>. Note that this only works for local requests. |
94 | |
fc7ec1d9 |
95 | =cut |
96 | |
fc7ec1d9 |
97 | sub import { |
66d9e175 |
98 | my $self = shift; |
45374ac6 |
99 | my $class = shift; |
100 | |
101 | my ( $get, $request ); |
102 | |
d96e14c2 |
103 | if ( $ENV{CATALYST_SERVER} ) { |
45374ac6 |
104 | $request = sub { remote_request(@_) }; |
105 | $get = sub { remote_request(@_)->content }; |
fb02aed1 |
106 | } elsif (! $class) { |
107 | $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") }; |
108 | $get = $request; |
109 | } else { |
16d306fa |
110 | unless( Class::Inspector->loaded( $class ) ) { |
1e514a51 |
111 | require Class::Inspector->filename( $class ); |
af81c980 |
112 | } |
d96e14c2 |
113 | $class->import; |
114 | |
0f895006 |
115 | $request = sub { local_request( $class, @_ ) }; |
116 | $get = sub { local_request( $class, @_ )->content }; |
49faa307 |
117 | } |
45374ac6 |
118 | |
119 | no strict 'refs'; |
120 | my $caller = caller(0); |
26dd6d9f |
121 | |
f2e13bbd |
122 | *{"$caller\::request"} = $request; |
123 | *{"$caller\::get"} = $get; |
124 | *{"$caller\::ctx_request"} = sub { |
26dd6d9f |
125 | my $me = ref $self || $self; |
126 | |
f2e13bbd |
127 | ### throw an exception if ctx_request is being used against a remote |
26dd6d9f |
128 | ### server |
129 | Catalyst::Exception->throw("$me only works with local requests, not remote") |
130 | if $ENV{CATALYST_SERVER}; |
131 | |
132 | ### place holder for $c after the request finishes; reset every time |
133 | ### requests are done. |
134 | my $c; |
135 | |
136 | ### hook into 'dispatch' -- the function gets called after all plugins |
137 | ### have done their work, and it's an easy place to capture $c. |
138 | no warnings 'redefine'; |
139 | my $dispatch = Catalyst->can('dispatch'); |
140 | local *Catalyst::dispatch = sub { |
141 | $c = shift; |
142 | $dispatch->( $c, @_ ); |
143 | }; |
144 | |
145 | ### do the request; C::T::request will know about the class name, and |
146 | ### we've already stopped it from doing remote requests above. |
147 | my $res = $request->( @_ ); |
148 | |
149 | ### return both values |
150 | return ( $res, $c ); |
151 | }; |
45374ac6 |
152 | } |
153 | |
26dd6d9f |
154 | =head2 $res = Catalyst::Test::local_request( $AppClass, $url ); |
0f895006 |
155 | |
7ef58180 |
156 | Simulate a request using L<HTTP::Request::AsCGI>. |
157 | |
0f895006 |
158 | =cut |
159 | |
160 | sub local_request { |
161 | my $class = shift; |
162 | |
163 | require HTTP::Request::AsCGI; |
164 | |
165 | my $request = Catalyst::Utils::request( shift(@_) ); |
166 | my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup; |
167 | |
168 | $class->handle_request; |
169 | |
170 | return $cgi->restore->response; |
171 | } |
172 | |
523d44ec |
173 | my $agent; |
174 | |
26dd6d9f |
175 | =head2 $res = Catalyst::Test::remote_request( $url ); |
bea4160a |
176 | |
b77e7869 |
177 | Do an actual remote request using LWP. |
bea4160a |
178 | |
179 | =cut |
180 | |
45374ac6 |
181 | sub remote_request { |
45374ac6 |
182 | |
68eb5874 |
183 | require LWP::UserAgent; |
184 | |
d837e1a7 |
185 | my $request = Catalyst::Utils::request( shift(@_) ); |
0f895006 |
186 | my $server = URI->new( $ENV{CATALYST_SERVER} ); |
523d44ec |
187 | |
188 | if ( $server->path =~ m|^(.+)?/$| ) { |
890e8d18 |
189 | my $path = $1; |
190 | $server->path("$path") if $path; # need to be quoted |
f4c0f6f7 |
191 | } |
cdae055a |
192 | |
193 | # the request path needs to be sanitised if $server is using a |
194 | # non-root path due to potential overlap between request path and |
195 | # response path. |
196 | if ($server->path) { |
f4c0f6f7 |
197 | # If request path is '/', we have to add a trailing slash to the |
198 | # final request URI |
199 | my $add_trailing = $request->uri->path eq '/'; |
200 | |
cdae055a |
201 | my @sp = split '/', $server->path; |
202 | my @rp = split '/', $request->uri->path; |
203 | shift @sp;shift @rp; # leading / |
204 | if (@rp) { |
205 | foreach my $sp (@sp) { |
a7daf37e |
206 | $sp eq $rp[0] ? shift @rp : last |
cdae055a |
207 | } |
208 | } |
209 | $request->uri->path(join '/', @rp); |
f4c0f6f7 |
210 | |
211 | if ( $add_trailing ) { |
212 | $request->uri->path( $request->uri->path . '/' ); |
213 | } |
523d44ec |
214 | } |
215 | |
216 | $request->uri->scheme( $server->scheme ); |
217 | $request->uri->host( $server->host ); |
218 | $request->uri->port( $server->port ); |
219 | $request->uri->path( $server->path . $request->uri->path ); |
220 | |
68eb5874 |
221 | unless ($agent) { |
9ffadf88 |
222 | |
d837e1a7 |
223 | $agent = LWP::UserAgent->new( |
523d44ec |
224 | keep_alive => 1, |
225 | max_redirect => 0, |
226 | timeout => 60, |
451553f5 |
227 | |
228 | # work around newer LWP max_redirect 0 bug |
229 | # http://rt.cpan.org/Ticket/Display.html?id=40260 |
230 | requests_redirectable => [], |
523d44ec |
231 | ); |
d837e1a7 |
232 | |
523d44ec |
233 | $agent->env_proxy; |
234 | } |
45374ac6 |
235 | |
236 | return $agent->request($request); |
fc7ec1d9 |
237 | } |
238 | |
fc7ec1d9 |
239 | =head1 SEE ALSO |
240 | |
7ef58180 |
241 | L<Catalyst>, L<Test::WWW::Mechanize::Catalyst>, |
242 | L<Test::WWW::Selenium::Catalyst>, L<Test::More>, L<HTTP::Request::Common> |
fc7ec1d9 |
243 | |
0bf7ab71 |
244 | =head1 AUTHORS |
fc7ec1d9 |
245 | |
0bf7ab71 |
246 | Catalyst Contributors, see Catalyst.pm |
fc7ec1d9 |
247 | |
248 | =head1 COPYRIGHT |
249 | |
250 | This program is free software, you can redistribute it and/or modify it under |
251 | the same terms as Perl itself. |
252 | |
253 | =cut |
254 | |
255 | 1; |