X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FTest.pm;h=e121b350293bc707ce6d05d9b2f15e389158828b;hp=06c821fcc15e6d70fe9acc69ec5dd561cbf65a74;hb=dd5b1dc47018c241cafda7f2b565d6a39257a1bf;hpb=f8db2ed7cc69853222729adfdbb48e5e4bea9bd2 diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 06c821f..e121b35 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -7,8 +7,9 @@ use Test::More (); use Plack::Test; use Catalyst::Exception; use Catalyst::Utils; -use Class::MOP; +use Class::Load qw(load_class is_class_loaded); use Sub::Exporter; +use Moose::Util 'find_meta'; use Carp 'croak', 'carp'; sub _build_request_export { @@ -25,7 +26,7 @@ sub _build_request_export { return sub { croak "Must specify a test app: use Catalyst::Test 'TestApp'" } unless $class; - Class::MOP::load_class($class) unless Class::MOP::is_class_loaded($class); + load_class($class) unless is_class_loaded($class); $class->import; return sub { _local_request( $class, @_ ) }; @@ -58,7 +59,7 @@ sub _build_ctx_request_export { # hook into 'dispatch' -- the function gets called after all plugins # have done their work, and it's an easy place to capture $c. - my $meta = Class::MOP::get_metaclass_by_name($class); + my $meta = find_meta($class); $meta->make_mutable; $meta->add_after_method_modifier( "dispatch", sub { $ctx_closed_over = shift; @@ -295,22 +296,33 @@ sub _local_request { # HTML head parsing based on LWP::UserAgent # + # This is because if you make a remote request with LWP, then the + # from the returned HTML document will be used + # to fill in $res->base, as documented in HTTP::Response. We need + # to support this in local test requests so that they work 'the same'. + # # This is not just horrible and possibly broken, but also really # doesn't belong here. Whoever wants this should be working on # getting it into Plack::Test, or make a middleware out of it, or # whatever. Seriously - horrible. - require HTML::HeadParser; + if (!$resp->content_type || $resp->content_is_html) { + require HTML::HeadParser; - my $parser = HTML::HeadParser->new(); - $parser->xml_mode(1) if $resp->content_is_xhtml; - $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; + my $parser = HTML::HeadParser->new(); + $parser->xml_mode(1) if $resp->content_is_xhtml; + $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; - $parser->parse( $resp->content ); - my $h = $parser->header; - for my $f ( $h->header_field_names ) { - $resp->init_header( $f, [ $h->header($f) ] ); + $parser->parse( $resp->content ); + my $h = $parser->header; + for my $f ( $h->header_field_names ) { + $resp->init_header( $f, [ $h->header($f) ] ); + } } + # Another horrible hack to make the response headers have a + # 'status' field. This is for back-compat, but you should + # call $resp->code instead! + $resp->init_header('status', [ $resp->code ]); }, }, @_); }