From: Ash Berlin Date: Fri, 6 Feb 2009 23:01:31 +0000 (+0000) Subject: Checking in stuff that git svn seemed to un-commit somehow X-Git-Tag: 0.51~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab0b00e34c84030a407adce9be1a94c66b946fa5;hp=b38526cc3bf09f45787912db1cc2128427ece6cf;p=catagits%2FTest-WWW-Mechanize-Catalyst.git Checking in stuff that git svn seemed to un-commit somehow --- diff --git a/CHANGES b/CHANGES index 2013f2d..5be7a7b 100644 --- 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 --- 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 --- 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 --- 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 --- 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' ) }