X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FWWW%2FMechanize%2FCatalyst.pm;h=866a09f5aecfd42f3df4c666579220dc02777779;hb=d6fc3a22e3ac5404cbf4bebfae7dab3e8073ad01;hp=1230a4505f3b60970064d4ff99e6bae648e26faa;hpb=46377765ddd1edf4e7e17d1cee709786884740b3;p=catagits%2FTest-WWW-Mechanize-Catalyst.git diff --git a/lib/Test/WWW/Mechanize/Catalyst.pm b/lib/Test/WWW/Mechanize/Catalyst.pm index 1230a45..866a09f 100644 --- a/lib/Test/WWW/Mechanize/Catalyst.pm +++ b/lib/Test/WWW/Mechanize/Catalyst.pm @@ -1,38 +1,80 @@ package Test::WWW::Mechanize::Catalyst; -use strict; -use warnings; + +use Moose; + +use Carp qw/croak/; +require Catalyst::Test; # Do not call import use Encode qw(); use HTML::Entities; use Test::WWW::Mechanize; -use base qw(Test::WWW::Mechanize); -our $VERSION = '0.45'; + +extends 'Test::WWW::Mechanize', 'Moose::Object'; + +#use namespace::clean -execept => 'meta'; + +our $VERSION = '0.50'; +our $APP_CLASS; my $Test = Test::Builder->new(); -# the reason for the auxiliary package is that both WWW::Mechanize and -# Catalyst::Test have a subroutine named 'request' +has catalyst_app => ( + is => 'ro', + predicate => 'has_catalyst_app', +); + +has allow_external => ( + is => 'rw', + isa => 'Bool', + default => 0 +); + +has host => ( + is => 'rw', + isa => 'Str', + clearer => 'clear_host', + predicate => 'has_host', +); + +sub new { + my $class = shift; + + 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 + ); + + $self->BUILDALL; + + + return $self; +} + +sub BUILD { + my ($self) = @_; -sub allow_external { - my ( $self, $value ) = @_; - return $self->{allow_external} unless defined $value; - $self->{allow_external} = $value; + 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)); + } } sub _make_request { my ( $self, $request ) = @_; - $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar; - - 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", $request->uri ); - $request->authorization_basic( @creds ) if @creds; - my $response = Test::WWW::Mechanize::Catalyst::Aux::request($request); + my $response = $self->_do_catalyst_request($request); $response->header( 'Content-Base', $request->uri ); $response->request($request); if ( $request->uri->as_string =~ m{^/} ) { @@ -86,21 +128,57 @@ sub _make_request { return $response; } -sub import { - Test::WWW::Mechanize::Catalyst::Aux::import(@_); -} +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; -package Test::WWW::Mechanize::Catalyst::Aux; + return Catalyst::Test::local_request($self->{catalyst_app}, $request); +} sub import { - my ( $class, @args ) = @_; - eval { - require Catalyst::Test; - Catalyst::Test::import(@_); - }; - warn $@ if $@; + my ($class, $app) = @_; + + if (defined $app) { + Class::MOP::load_class($app) + unless (Class::MOP::is_class_loaded($app)); + $APP_CLASS = $app; + } + } + 1; __END__ @@ -112,29 +190,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 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 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 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 @@ -147,16 +230,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: @@ -176,7 +266,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. @@ -184,7 +274,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": @@ -201,6 +291,24 @@ single sign-on system. You must set allow_external to true for this: $m->allow_external(1); +head2 catalyst_app + +The name of the Catalyst app which we are testing against. Read-only. + +=head2 host + +The host value to set the "Host:" HTTP header to, if none is present already in +the request. If not set (default) then Catalyst::Test will set this to +localhost:80 + +=head2 clear_host + +Unset the host attribute. + +=head2 has_host + +Do we have a value set for the host attribute + =head2 $mech->get_ok($url, [ \%LWP_options ,] $desc) A wrapper around WWW::Mechanize's get(), with similar options, except the @@ -221,7 +329,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 (.+)/ @@ -331,8 +439,8 @@ 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" ); @@ -351,11 +459,13 @@ L, L. =head1 AUTHOR -Leon Brocard, C<< >> +Ash Berlin C<< >> (current maintiner) + +Original Author: Leon Brocard, C<< >> =head1 COPYRIGHT -Copyright (C) 2005-7, Leon Brocard +Copyright (C) 2005-8, Leon Brocard =head1 LICENSE