Checking in stuff that git svn seemed to un-commit somehow

diff --git a/CHANGES b/CHANGES
index 2013f2d..5be7a7b 100644 (file)
--- a/CHANGES
+++ b/CHANGES
@@ -1,6 +1,6 @@
 Revision history for Perl module Test::WWW::Mechanize::Catalyst:
 
-0.50
+0.50_1 Thur Feb 5 09:02 GMT 2008
      - App classname no longer has to be passed to import:
         $m = T::W::M::C->new(catalyst_app => 'Catty')
        now works.
@@ -8,7 +8,10 @@ Revision history for Perl module Test::WWW::Mechanize::Catalyst:
        interpreter due to the above change
      - Removed Test::WWW::Mechanize::Catalyst::Aux package as it isn't needed
        any more
-     - Add 'host' accessor for white-label testing 
+     - Add 'host' accessor for white-label testing
+     - Moosification
+     - Can now test against remote CATALYST_SERVER without having to load the
+       app class
 
 0.45 Mon Nov 24 20:39:19 GMT 2008
      - be forwards-compatible with Catalyst 5.80's virtual 

diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index 37e81eb..30dfa18 100644 (file)
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -31,3 +31,5 @@
 \.gz$
 \.tar$
 
+svn.authors
+^\.git

diff --git a/Makefile.PL b/Makefile.PL
index 9399a41..3e50e0a 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -19,4 +19,9 @@ test_requires 'Catalyst::Plugin::Session::Store::Dummy'  => '0';
 test_requires 'Test::Exception'                          => '0';
 test_requires 'Test::More'                               => '0';
 
+if ($Module::Install::AUTHOR) {
+  system('pod2text lib/Test/WWW/Mechanize/Catalyst.pm > README');
+}
+
+
 WriteAll;

diff --git a/lib/Test/WWW/Mechanize/Catalyst.pm b/lib/Test/WWW/Mechanize/Catalyst.pm
index b19e138..45bc029 100644 (file)
--- a/lib/Test/WWW/Mechanize/Catalyst.pm
+++ b/lib/Test/WWW/Mechanize/Catalyst.pm
@@ -12,14 +12,13 @@ extends 'Test::WWW::Mechanize', 'Moose::Object';
 
 use namespace::clean -execept => 'meta';
 
-our $VERSION = '0.45';
+our $VERSION = '0.50_1';
 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 => (
@@ -41,46 +40,24 @@ sub new {
   my $obj = $class->SUPER::new(@_);
   my $self = $class->meta->new_object(
     __INSTANCE__ => $obj,
+    ($APP_CLASS ? (catalyst_app => $APP_CLASS) : () ),
     @_
   );
 
-  Class::MOP::load_class($self->catalyst_app)
-    unless (Class::MOP::is_class_loaded($self->catalyst_app));
+  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));
+  }
 
   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;
-
-      $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;
-
-    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{^/} ) {
@@ -134,6 +111,45 @@ sub _make_request {
     return $response;
 }
 
+sub _do_catalyst_request {
+    my ($self, $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};
+
+    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;
+
+      $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,16 +173,21 @@ 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
 

diff --git a/t/multi_content_type.t b/t/multi_content_type.t
index 5805b6d..6fbdaa4 100644 (file)
--- a/t/multi_content_type.t
+++ b/t/multi_content_type.t
@@ -29,7 +29,7 @@ $SIG{INT} = sub { warn "INT:$$"; exit };
 use_ok 'ExternalCatty';
 my $pid = ExternalCatty->background($PORT);
 
-use Test::WWW::Mechanize::Catalyst 'ExternalCatty';
+use Test::WWW::Mechanize::Catalyst;
 my $m = Test::WWW::Mechanize::Catalyst->new;
 
 lives_ok { $m->get_ok( '/', 'Get a multi Content-Type response' ) }