X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FTest.pm;h=9e0db012c10a40194eae90d8e9d02a2820017109;hb=250cad0f65cf92f1a48dcbd7db4952970563a3c2;hp=26d60725d764ff23ae99a8731bd0a8fd481719f7;hpb=5a162b56ed17855fbfbecfa662af5b3a38527984;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 26d6072..9e0db01 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -5,7 +5,7 @@ use warnings; use Catalyst::Exception; use Catalyst::Utils; -use UNIVERSAL::require; +use Class::Inspector; =head1 NAME @@ -21,6 +21,12 @@ Catalyst::Test - Test Catalyst Applications request('index.html'); get('index.html'); + use HTTP::Request::Common; + my $response = request POST '/foo', [ + bar => 'baz', + something => 'else' + ]; + # Run tests against a remote server CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/ @@ -45,7 +51,13 @@ Catalyst::Test - Test Catalyst Applications =head1 DESCRIPTION -Test Catalyst Applications. +This module allows you to make requests to a Catalyst application either without +a server, by simulating the environment of an HTTP request using +L or remotely if you define the CATALYST_SERVER +environment variable. + +The and functions take either a URI or an L +object. =head2 METHODS @@ -55,6 +67,17 @@ Returns the content. my $content = get('foo/bar?test=1'); +Note that this method doesn't follow redirects, so to test for a +correctly redirecting page you'll need to use a combination of this +method and the L method below: + + my $res = request('/'); # redirects to /y + warn $res->header('location'); + use URI; + my $uri = URI->new($res->header('location')); + is ( $uri->path , '/y'); + my $content = get($uri->path); + =head2 request Returns a C object. @@ -72,11 +95,13 @@ sub import { if ( $ENV{CATALYST_SERVER} ) { $request = sub { remote_request(@_) }; $get = sub { remote_request(@_)->content }; - } - - else { - $class->require; - die if $@ && $@ !~ /^Can't locate /; + } elsif (! $class) { + $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") }; + $get = $request; + } else { + unless( Class::Inspector->loaded( $class ) ) { + require Class::Inspector->filename( $class ); + } $class->import; $request = sub { local_request( $class, @_ ) }; @@ -91,6 +116,8 @@ sub import { =head2 local_request +Simulate a request using L. + =cut sub local_request { @@ -122,7 +149,31 @@ sub remote_request { my $server = URI->new( $ENV{CATALYST_SERVER} ); if ( $server->path =~ m|^(.+)?/$| ) { - $server->path("$1"); # need to be quoted + my $path = $1; + $server->path("$path") if $path; # need to be quoted + } + + # the request path needs to be sanitised if $server is using a + # non-root path due to potential overlap between request path and + # response path. + if ($server->path) { + # If request path is '/', we have to add a trailing slash to the + # final request URI + my $add_trailing = $request->uri->path eq '/'; + + my @sp = split '/', $server->path; + my @rp = split '/', $request->uri->path; + shift @sp;shift @rp; # leading / + if (@rp) { + foreach my $sp (@sp) { + $sp eq $rp[0] ? shift @rp : last + } + } + $request->uri->path(join '/', @rp); + + if ( $add_trailing ) { + $request->uri->path( $request->uri->path . '/' ); + } } $request->uri->scheme( $server->scheme ); @@ -146,11 +197,12 @@ sub remote_request { =head1 SEE ALSO -L. +L, L, +L, L, L -=head1 AUTHOR +=head1 AUTHORS -Sebastian Riedel, C +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT