X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FWWW%2FMechanize%2FCatalyst.pm;h=4b05075bdad974f4ffe3705ff60acb9875fc2524;hb=60f2b4d9f5424b3b73780eada1bbfd64a006e625;hp=e9e91c6ae8db3c485a0b0f67daee2f142e108fb3;hpb=dabec5e2ff6722fb97852568b29a7890582b8dd1;p=catagits%2FTest-WWW-Mechanize-Catalyst.git diff --git a/lib/Test/WWW/Mechanize/Catalyst.pm b/lib/Test/WWW/Mechanize/Catalyst.pm index e9e91c6..4b05075 100644 --- a/lib/Test/WWW/Mechanize/Catalyst.pm +++ b/lib/Test/WWW/Mechanize/Catalyst.pm @@ -10,9 +10,9 @@ use Test::WWW::Mechanize; extends 'Test::WWW::Mechanize', 'Moose::Object'; -use namespace::clean -execept => 'meta'; +#use namespace::clean -execept => 'meta'; -our $VERSION = '0.50'; +our $VERSION = '0.57'; our $APP_CLASS; my $Test = Test::Builder->new(); @@ -72,15 +72,12 @@ sub BUILD { } sub _make_request { - my ( $self, $request ) = @_; + my ( $self, $request, $arg, $size, $previous) = @_; my $response = $self->_do_catalyst_request($request); - $response->header( 'Content-Base', $request->uri ); - $response->request($request); - if ( $request->uri->as_string =~ m{^/} ) { - $request->uri( - URI->new( 'http://localhost:80/' . $request->uri->as_string ) ); - } + $response->header( 'Content-Base', $response->request->uri ) + unless $response->header('Content-Base'); + $self->cookie_jar->extract_cookies($response) if $self->cookie_jar; # fail tests under the Catalyst debug screen @@ -97,30 +94,32 @@ sub _make_request { $response->content_type(''); } + # NOTE: cargo-culted redirect checking from LWP::UserAgent: + $response->previous($previous) if $previous; + my $redirects = defined $response->redirects ? $response->redirects : 0; + if ($redirects > 0 and $redirects >= $self->max_redirect) { + return $self->_redirect_loop_detected($response); + } + # check if that was a redirect if ( $response->header('Location') + && $response->is_redirect && $self->redirect_ok( $request, $response ) ) { + return $self->_redirect_loop_detected($response) if $self->max_redirect <= 0; - # remember the old response - my $old_response = $response; + # TODO: this should probably create the request by cloning the original + # request and modifying it as LWP::UserAgent::request does. But for now... # *where* do they want us to redirect to? - my $location = $old_response->header('Location'); + my $location = $response->header('Location'); # no-one *should* be returning non-absolute URLs, but if they # are then we'd better cope with it. Let's create a new URI, using # our request as the base. my $uri = URI->new_abs( $location, $request->uri )->as_string; - - # make a new response, and save the old response in it - $response = $self->_make_request( HTTP::Request->new( GET => $uri ) ); - my $end_of_chain = $response; - while ( $end_of_chain->previous ) # keep going till the end - { - $end_of_chain = $end_of_chain->previous; - } # of the chain... - $end_of_chain->previous($old_response); # ...and add us to it + my $referral = HTTP::Request->new( GET => $uri ); + return $self->request( $referral, $arg, $size, $response ); } else { $response->{_raw_content} = $response->content; } @@ -128,6 +127,26 @@ sub _make_request { return $response; } +sub _redirect_loop_detected { + my ( $self, $response ) = @_; + $response->header("Client-Warning" => + "Redirect loop detected (max_redirect = " . $self->max_redirect . ")"); + $response->{_raw_content} = $response->content; + return $response; +} + +sub _set_host_header { + my ( $self, $request ) = @_; + # If there's no Host header, set one. + unless ($request->header('Host')) { + my $host = $self->has_host + ? $self->host + : $request->uri->host; + $host .= ':'.$request->uri->_port if $request->uri->_port; + $request->header('Host', $host); + } +} + sub _do_catalyst_request { my ($self, $request) = @_; @@ -135,35 +154,87 @@ sub _do_catalyst_request { $uri->scheme('http') unless defined $uri->scheme; $uri->host('localhost') unless defined $uri->host; + $request = $self->prepare_request($request); $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar; # Woe betide anyone who unsets CATALYST_SERVER - return Catalyst::Test::remote_request($request) + return $self->_do_remote_request($request) if $ENV{CATALYST_SERVER}; + $self->_set_host_header($request); + my $res = $self->_check_external_request($request); + return $res if $res; - # If there's no Host header, set one. - unless ($request->header('Host')) { - my $host = $self->has_host - ? $self->host - : $uri->host; + my @creds = $self->get_basic_credentials( "Basic", $uri ); + $request->authorization_basic( @creds ) if @creds; - $request->header('Host', $host); + require Catalyst; + my $response = $Catalyst::VERSION >= 5.89000 ? + Catalyst::Test::_local_request($self->{catalyst_app}, $request) : + Catalyst::Test::local_request($self->{catalyst_app}, $request); + + + # LWP would normally do this, but we dont get down that far. + $response->request($request); + + return $response +} + +sub _check_external_request { + my ($self, $request) = @_; + + # If there's no host then definatley not an external request. + $request->uri->can('host_port') or return; + + if ( $self->allow_external && $request->uri->host_port ne 'localhost:80' ) { + return $self->SUPER::_make_request($request); } - - if ( $self->{allow_external} ) { - unless ( $request->uri->as_string =~ m{^/} - || $request->uri->host eq 'localhost' ) - { - return $self->SUPER::_make_request($request); + return undef; +} + +sub _do_remote_request { + my ($self, $request) = @_; + + my $res = $self->_check_external_request($request); + return $res if $res; + + my $server = URI->new( $ENV{CATALYST_SERVER} ); + + if ( $server->path =~ m|^(.+)?/$| ) { + 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 . '/' ); } } - - my @creds = $self->get_basic_credentials( "Basic", $uri ); - $request->authorization_basic( @creds ) if @creds; - return Catalyst::Test::local_request($self->{catalyst_app}, $request); + $request->uri->scheme( $server->scheme ); + $request->uri->host( $server->host ); + $request->uri->port( $server->port ); + $request->uri->path( $server->path . $request->uri->path ); + $self->_set_host_header($request); + return $self->SUPER::_make_request($request); } sub import { @@ -207,16 +278,16 @@ Test::WWW::Mechanize::Catalyst - Test::WWW::Mechanize for Catalyst =head1 DESCRIPTION -L is an elegant MVC Web Application -Framework. L is a subclass of L that -incorporates features for web application testing. The -L module meshes the two to allow easy -testing of L applications without starting up a web server. +L is an elegant MVC Web Application Framework. +L is a subclass of L that incorporates +features for web application testing. The L +module meshes the two to allow easy testing of L applications without +needing to start up a web server. Testing web applications has always been a bit tricky, normally -starting a web server for your application and making real HTTP +requiring starting a web server for your application and making real HTTP requests to it. This module allows you to test L web -applications but does not start a server or issue HTTP +applications but does not require a server or issue HTTP requests. Instead, it passes the HTTP request object directly to L. Thus you do not need to use a real hostname: "http://localhost/" will do. However, this is optional. The following @@ -229,16 +300,23 @@ Links which do not begin with / or are not for localhost can be handled as normal Web requests - this is handy if you have an external single sign-on system. You must set allow_external to true for this: - $m->allow_external(1); + $mech->allow_external(1); You can also test a remote server by setting the environment variable -CATALYST_SERVER, for example: +CATALYST_SERVER; for example: $ CATALYST_SERVER=http://example.com/myapp prove -l t will run the same tests on the application running at http://example.com/myapp regardless of whether or not you specify http:://localhost for Test::WWW::Mechanize::Catalyst. + +Furthermore, if you set CATALYST_SERVER, the server will be regarded +as a remote server even if your links point to localhost. Thus, you +can use Test::WWW::Mechanize::Catalyst to test your live webserver +running on your local machine, if you need to test aspects of your +deployment environment (for example, configuration options in an +http.conf file) instead of just the Catalyst request handling. This makes testing fast and easy. L provides functions for common web testing scenarios. For example: @@ -253,12 +331,12 @@ This module supports cookies automatically. To use this module you must pass it the name of the application. See the SYNOPSIS above. -Note that Catalyst has a special developing feature: the debug +Note that Catalyst has a special development feature: the debug screen. By default this module will treat responses which are the debug screen as failures. If you actually want to test debug screens, please use: - $m->{catalyst_debug} = 1; + $mech->{catalyst_debug} = 1; An alternative to this module is L. @@ -266,7 +344,7 @@ An alternative to this module is L. =head2 new -Behaves like, and calls, L's C method. Any parms +Behaves like, and calls, L's C method. Any params passed in get passed to WWW::Mechanize's constructor. Note that we need to pass the name of the Catalyst application to the "use": @@ -281,7 +359,7 @@ Links which do not begin with / or are not for localhost can be handled as normal Web requests - this is handy if you have an external single sign-on system. You must set allow_external to true for this: - $m->allow_external(1); + $mech->allow_external(1); head2 catalyst_app @@ -321,13 +399,13 @@ Tells if the title of the page matches the given regex. =head2 $mech->title_unlike( $regex [, $desc ] ) -Tells if the title of the page matches the given regex. +Tells if the title of the page does NOT match the given regex. $mech->title_unlike( qr/Invoices for (.+)/ =head2 $mech->content_is( $str [, $desc ] ) -Tells if the content of the page matches the given string +Tells if the content of the page matches the given string. =head2 $mech->content_contains( $str [, $desc ] ) @@ -416,7 +494,7 @@ or a scalar URL name. =head2 $mech->link_content_unlike( $links, $regex [, $desc ] ) -Check the current page for specified links and test the content of each +Check the current page for specified links and test that the content of each does not match I<$regex>. The links may be specified as a reference to an array containing L objects, an array of URLs, or a scalar URL name. @@ -431,11 +509,11 @@ Makes a C call and executes tests on the results. The link must be found, and then followed successfully. Otherwise, this test fails. -I<%parms> is a hashref containing the parms to pass to C. -Note that the parms to C are a hash whereas the parms to +I<%parms> is a hashref containing the params to pass to C. +Note that the params to C are a hash whereas the parms to this function are a hashref. You have to call this function like: - $agent->follow_like_ok( {n=>3}, "looking for 3rd link" ); + $agent->follow_link_ok( {n=>3}, "looking for 3rd link" ); As with other test functions, C<$comment> is optional. If it is supplied then it will display when running the test harness in verbose mode. @@ -444,6 +522,21 @@ Returns true value if the specified link was found and followed successfully. The HTTP::Response object returned by follow_link() is not available. +=head1 CAVEATS + +=head2 External Redirects and allow_external + +If you use non-fully qualified urls in your test scripts (i.e. anything without +a host, such as C<< ->get_ok( "/foo") >> ) and your app redirects to an +external URL, expect to be bitten once you come back to your application's urls +(it will try to request them on the remote server). This is due to a limitation +in WWW::Mechanize. + +One workaround for this is that if you are expecting to redirect to an external +site, clone the TWMC object and use the cloned object for the external +redirect. + + =head1 SEE ALSO Related modules which may be of interest: L, @@ -457,7 +550,7 @@ Original Author: Leon Brocard, C<< >> =head1 COPYRIGHT -Copyright (C) 2005-8, Leon Brocard +Copyright (C) 2005-9, Leon Brocard =head1 LICENSE