[Catalyst-commits] r9234 - in Test-WWW-Mechanize-Catalyst/trunk: .
lib/Test/WWW/Mechanize t
ash at dev.catalyst.perl.org
ash at dev.catalyst.perl.org
Fri Feb 6 23:01:31 GMT 2009
Author: ash
Date: 2009-02-06 23:01:31 +0000 (Fri, 06 Feb 2009)
New Revision: 9234
Modified:
Test-WWW-Mechanize-Catalyst/trunk/CHANGES
Test-WWW-Mechanize-Catalyst/trunk/MANIFEST.SKIP
Test-WWW-Mechanize-Catalyst/trunk/Makefile.PL
Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm
Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t
Log:
Checking in stuff that git svn seemed to un-commit somehow
Modified: Test-WWW-Mechanize-Catalyst/trunk/CHANGES
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/CHANGES 2009-02-06 21:11:15 UTC (rev 9233)
+++ Test-WWW-Mechanize-Catalyst/trunk/CHANGES 2009-02-06 23:01:31 UTC (rev 9234)
@@ -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 @@
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
Modified: Test-WWW-Mechanize-Catalyst/trunk/MANIFEST.SKIP
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/MANIFEST.SKIP 2009-02-06 21:11:15 UTC (rev 9233)
+++ Test-WWW-Mechanize-Catalyst/trunk/MANIFEST.SKIP 2009-02-06 23:01:31 UTC (rev 9234)
@@ -31,3 +31,5 @@
\.gz$
\.tar$
+svn.authors
+^\.git
Modified: Test-WWW-Mechanize-Catalyst/trunk/Makefile.PL
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/Makefile.PL 2009-02-06 21:11:15 UTC (rev 9233)
+++ Test-WWW-Mechanize-Catalyst/trunk/Makefile.PL 2009-02-06 23:01:31 UTC (rev 9234)
@@ -19,4 +19,9 @@
test_requires 'Test::Exception' => '0';
test_requires 'Test::More' => '0';
+if ($Module::Install::AUTHOR) {
+ system('pod2text lib/Test/WWW/Mechanize/Catalyst.pm > README');
+}
+
+
WriteAll;
Modified: Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm 2009-02-06 21:11:15 UTC (rev 9233)
+++ Test-WWW-Mechanize-Catalyst/trunk/lib/Test/WWW/Mechanize/Catalyst.pm 2009-02-06 23:01:31 UTC (rev 9234)
@@ -12,14 +12,13 @@
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 @@
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 @@
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 @@
=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
Modified: Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t
===================================================================
--- Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t 2009-02-06 21:11:15 UTC (rev 9233)
+++ Test-WWW-Mechanize-Catalyst/trunk/t/multi_content_type.t 2009-02-06 23:01:31 UTC (rev 9234)
@@ -29,7 +29,7 @@
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' ) }
More information about the Catalyst-commits
mailing list