1 package Catalyst::Test;
6 use Catalyst::Exception;
12 Catalyst::Test - Test Catalyst Applications
20 use Catalyst::Test 'TestApp';
21 my $content = get('index.html'); # Content as string
22 my $response = request('index.html'); # HTTP::Response object
23 my($res, $c) = ctx_request('index.html'); # HTTP::Response & context object
25 use HTTP::Request::Common;
26 my $response = request POST '/foo', [
31 # Run tests against a remote server
32 CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/
34 # Tests with inline apps need to use Catalyst::Engine::Test
40 my ( $self, $c ) = @_;
41 $c->res->output('bar');
48 use Test::More tests => 1;
49 use Catalyst::Test 'TestApp';
51 ok( get('/foo') =~ /bar/ );
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
60 The </get> and </request> functions take either a URI or an L<HTTP::Request>
65 =head2 $content = get( ... )
69 my $content = get('foo/bar?test=1');
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:
75 my $res = request('/'); # redirects to /y
76 warn $res->header('location');
78 my $uri = URI->new($res->header('location'));
79 is ( $uri->path , '/y');
80 my $content = get($uri->path);
82 =head2 $res = request( ... );
84 Returns a C<HTTP::Response> object.
86 my $res = request('foo/bar?test=1');
90 =head2 ($res, $c) = ctx_request( ... );
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.
101 my ( $get, $request );
103 if ( $ENV{CATALYST_SERVER} ) {
104 $request = sub { remote_request(@_) };
105 $get = sub { remote_request(@_)->content };
107 $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") };
110 unless( Class::Inspector->loaded( $class ) ) {
111 require Class::Inspector->filename( $class );
115 $request = sub { local_request( $class, @_ ) };
116 $get = sub { local_request( $class, @_ )->content };
120 my $caller = caller(0);
122 *{"$caller\::request"} = $request;
123 *{"$caller\::get"} = $get;
124 *{"$caller\::ctx_request"} = sub {
125 my $me = ref $self || $self;
127 ### throw an exception if ctx_request is being used against a remote
129 Catalyst::Exception->throw("$me only works with local requests, not remote")
130 if $ENV{CATALYST_SERVER};
132 ### place holder for $c after the request finishes; reset every time
133 ### requests are done.
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 {
142 $dispatch->( $c, @_ );
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->( @_ );
149 ### return both values
154 =head2 $res = Catalyst::Test::local_request( $AppClass, $url );
156 Simulate a request using L<HTTP::Request::AsCGI>.
163 require HTTP::Request::AsCGI;
165 my $request = Catalyst::Utils::request( shift(@_) );
166 my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup;
168 $class->handle_request;
170 return $cgi->restore->response;
175 =head2 $res = Catalyst::Test::remote_request( $url );
177 Do an actual remote request using LWP.
183 require LWP::UserAgent;
185 my $request = Catalyst::Utils::request( shift(@_) );
186 my $server = URI->new( $ENV{CATALYST_SERVER} );
188 if ( $server->path =~ m|^(.+)?/$| ) {
190 $server->path("$path") if $path; # need to be quoted
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
197 # If request path is '/', we have to add a trailing slash to the
199 my $add_trailing = $request->uri->path eq '/';
201 my @sp = split '/', $server->path;
202 my @rp = split '/', $request->uri->path;
203 shift @sp;shift @rp; # leading /
205 foreach my $sp (@sp) {
206 $sp eq $rp[0] ? shift @rp : last
209 $request->uri->path(join '/', @rp);
211 if ( $add_trailing ) {
212 $request->uri->path( $request->uri->path . '/' );
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 );
223 $agent = LWP::UserAgent->new(
228 # work around newer LWP max_redirect 0 bug
229 # http://rt.cpan.org/Ticket/Display.html?id=40260
230 requests_redirectable => [],
236 return $agent->request($request);
241 L<Catalyst>, L<Test::WWW::Mechanize::Catalyst>,
242 L<Test::WWW::Selenium::Catalyst>, L<Test::More>, L<HTTP::Request::Common>
246 Catalyst Contributors, see Catalyst.pm
250 This program is free software, you can redistribute it and/or modify it under
251 the same terms as Perl itself.