TWMC: Fix bug where redirect was followed on a 500 response
[catagits/Test-WWW-Mechanize-Catalyst.git] / lib / Test / WWW / Mechanize / Catalyst.pm
index b19e138..8910c44 100644 (file)
@@ -10,16 +10,15 @@ use Test::WWW::Mechanize;
 
 extends 'Test::WWW::Mechanize', 'Moose::Object';
 
-use namespace::clean -execept => 'meta';
+#use namespace::clean -execept => 'meta';
 
-our $VERSION = '0.45';
+our $VERSION = '0.50';
 our $APP_CLASS;
 my $Test = Test::Builder->new();
 
 has catalyst_app => (
   is => 'ro',
-  required => 1,
-  default => sub { $APP_CLASS },
+  predicate => 'has_catalyst_app',
 );
 
 has allow_external => (
@@ -38,49 +37,44 @@ has host => (
 sub new {
   my $class = shift;
 
-  my $obj = $class->SUPER::new(@_);
+  my $args = ref $_[0] ? $_[0] : { @_ };
+  
+  # Dont let LWP complain about options for our attributes
+  my %attr_options = map {
+    my $n = $_->init_arg;
+    defined $n && exists $args->{$n} 
+        ? ( $n => delete $args->{$n} )
+        : ( );
+  } $class->meta->get_all_attributes;
+
+  my $obj = $class->SUPER::new(%$args);
   my $self = $class->meta->new_object(
     __INSTANCE__ => $obj,
-    @_
+    ($APP_CLASS ? (catalyst_app => $APP_CLASS) : () ),
+    %attr_options
   );
 
-  Class::MOP::load_class($self->catalyst_app)
-    unless (Class::MOP::is_class_loaded($self->catalyst_app));
+  $self->BUILDALL;
+
 
   return $self;
 }
 
-sub _make_request {
-    my ( $self, $request ) = @_;
-    $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar;
-
-    my $uri = $request->uri;
-    if ($uri->as_string =~ m{^/}) {
-      $uri->scheme('http');
-      $uri->host('localhost');
-    }
-
-    # If there's no Host header, set one.
-    unless ($request->header('Host')) {
-      my $host = $self->has_host
-               ? $self->host
-               : $uri->host;
+sub BUILD {
+  my ($self) = @_;
 
-      $request->header('Host', $host);
-    }
+  unless ($ENV{CATALYST_SERVER}) {
+    croak "catalyst_app attribute is required unless CATALYST_SERVER env variable is set"
+      unless $self->has_catalyst_app;
+    Class::MOP::load_class($self->catalyst_app)
+      unless (Class::MOP::is_class_loaded($self->catalyst_app));
+  }
+}
 
-    if ( $self->{allow_external} ) {
-        unless ( $request->uri->as_string =~ m{^/}
-            || $request->uri->host eq 'localhost' )
-        {
-            return $self->SUPER::_make_request($request);
-        }
-    }
-  
-    my @creds = $self->get_basic_credentials( "Basic", $uri );
-    $request->authorization_basic( @creds ) if @creds;
+sub _make_request {
+    my ( $self, $request ) = @_;
 
-    my $response = Catalyst::Test::local_request($self->{catalyst_app}, $request);
+    my $response = $self->_do_catalyst_request($request);
     $response->header( 'Content-Base', $request->uri );
     $response->request($request);
     if ( $request->uri->as_string =~ m{^/} ) {
@@ -105,6 +99,7 @@ sub _make_request {
 
     # check if that was a redirect
     if (   $response->header('Location')
+        && $response->is_redirect
         && $self->redirect_ok( $request, $response ) )
     {
 
@@ -134,6 +129,43 @@ sub _make_request {
     return $response;
 }
 
+sub _do_catalyst_request {
+    my ($self, $request) = @_;
+
+    my $uri = $request->uri;
+    $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)
+      if $ENV{CATALYST_SERVER};
+
+    # If there's no Host header, set one.
+    unless ($request->header('Host')) {
+      my $host = $self->has_host
+               ? $self->host
+               : $uri->host;
+
+      $request->header('Host', $host);
+    }
+  
+    if ( $self->{allow_external} ) {
+        unless ( $request->uri->as_string =~ m{^/}
+            || $request->uri->host eq 'localhost' )
+        {
+            return $self->SUPER::_make_request($request);
+        }
+    }
+  
+    my @creds = $self->get_basic_credentials( "Basic", $uri );
+    $request->authorization_basic( @creds ) if @creds;
+
+    return Catalyst::Test::local_request($self->{catalyst_app}, $request);
+}
+
 sub import {
   my ($class, $app) = @_;
 
@@ -157,29 +189,34 @@ Test::WWW::Mechanize::Catalyst - Test::WWW::Mechanize for Catalyst
 =head1 SYNOPSIS
 
   # We're in a t/*.t test script...
+  use Test::WWW::Mechanize::Catalyst;
+
   # To test a Catalyst application named 'Catty':
-  use Test::WWW::Mechanize::Catalyst 'Catty';
+  my $mech = Test::WWW::Mechanize::Catalyst->new(catalyst_app => 'Catty');
 
-  my $mech = Test::WWW::Mechanize::Catalyst->new;
   $mech->get_ok("/"); # no hostname needed
   is($mech->ct, "text/html");
   $mech->title_is("Root", "On the root page");
   $mech->content_contains("This is the root page", "Correct content");
   $mech->follow_link_ok({text => 'Hello'}, "Click on Hello");
   # ... and all other Test::WWW::Mechanize methods
+  
+  # White label site testing
+  $mech->host("foo.com");
+  $mech->get_ok("/");
 
 =head1 DESCRIPTION
 
-L<Catalyst> is an elegant MVC Web Application
-Framework. L<Test::WWW::Mechanize> is a subclass of L<WWW::Mechanize> that
-incorporates features for web application testing. The
-L<Test::WWW::Mechanize::Catalyst> module meshes the two to allow easy
-testing of L<Catalyst> applications without starting up a web server.
+L<Catalyst> is an elegant MVC Web Application Framework.
+L<Test::WWW::Mechanize> is a subclass of L<WWW::Mechanize> that incorporates
+features for web application testing. The L<Test::WWW::Mechanize::Catalyst>
+module meshes the two to allow easy testing of L<Catalyst> applications without
+needing to starting 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<Catalyst> 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<Catalyst>. Thus you do not need to use a real hostname:
 "http://localhost/" will do. However, this is optional. The following
@@ -192,16 +229,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<Test::WWW::Mechanize> provides
 functions for common web testing scenarios. For example:
@@ -221,7 +265,7 @@ 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;
+  $mmech->{catalyst_debug} = 1;
 
 An alternative to this module is L<Catalyst::Test>.
 
@@ -229,7 +273,7 @@ An alternative to this module is L<Catalyst::Test>.
 
 =head2 new
 
-Behaves like, and calls, L<WWW::Mechanize>'s C<new> method.  Any parms
+Behaves like, and calls, L<WWW::Mechanize>'s C<new> 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":
 
@@ -284,7 +328,7 @@ 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 (.+)/
 
@@ -394,8 +438,8 @@ Makes a C<follow_link()> 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<follow_link()>.
-Note that the parms to C<follow_link()> are a hash whereas the parms to
+I<%parms> is a hashref containing the params to pass to C<follow_link()>.
+Note that the params to C<follow_link()> 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" );
@@ -407,6 +451,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 obeject and use the cloned object for the external
+redirect.
+
+
 =head1 SEE ALSO
 
 Related modules which may be of interest: L<Catalyst>,