X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FTest-WWW-Mechanize-Catalyst.git;a=blobdiff_plain;f=lib%2FTest%2FWWW%2FMechanize%2FCatalyst.pm;h=e9e91c6ae8db3c485a0b0f67daee2f142e108fb3;hp=4248f49c460802a3f34ca315ded30b55c03c6d72;hb=dabec5e2ff6722fb97852568b29a7890582b8dd1;hpb=cfd812d6df038fa098c69af4e8a80e0342e7b1ce diff --git a/lib/Test/WWW/Mechanize/Catalyst.pm b/lib/Test/WWW/Mechanize/Catalyst.pm index 4248f49..e9e91c6 100644 --- a/lib/Test/WWW/Mechanize/Catalyst.pm +++ b/lib/Test/WWW/Mechanize/Catalyst.pm @@ -12,7 +12,7 @@ extends 'Test::WWW::Mechanize', 'Moose::Object'; use namespace::clean -execept => 'meta'; -our $VERSION = '0.50_2'; +our $VERSION = '0.50'; our $APP_CLASS; my $Test = Test::Builder->new(); @@ -37,21 +37,38 @@ 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 ); + $self->BUILDALL; + + + return $self; +} + +sub BUILD { + my ($self) = @_; + 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 { @@ -114,17 +131,16 @@ sub _make_request { 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; + $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.