X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FTest.pm;h=1fd6a76a999cbb4a96a3cd4faa78fb391cd9c730;hb=dd4530ecdc4684838d9c0e9dc00adebb6100b022;hp=fbc8adafeac9dfdb47f2ae5c1a80b385f4fe1fb5;hpb=6664017d52356034039e06899caee41ca63fc58c;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index fbc8ada..1fd6a76 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -7,9 +7,11 @@ 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'; +use Ref::Util qw(is_plain_coderef is_plain_hashref); sub _build_request_export { my ($self, $args) = @_; @@ -25,7 +27,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 +60,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; @@ -152,7 +154,7 @@ say: use Catalyst::Test (); # If you don't want to import a test app right now. or say: use Catalyst::Test 'MyApp'; # If you do want to import a test app.\n\n}) unless $class; $import->($self, '-all' => { class => $class }); - $opts = {} unless ref $opts eq 'HASH'; + $opts = {} unless is_plain_hashref($opts); $default_host = $opts->{default_host} if exists $opts->{default_host}; return 1; } @@ -289,7 +291,7 @@ sub _local_request { my $class = shift; return _request({ - app => ref($class) eq "CODE" ? $class : $class->_finalized_psgi_app, + app => is_plain_coderef($class) ? $class : $class->_finalized_psgi_app, mangle_response => sub { my ($resp) = @_; @@ -305,16 +307,18 @@ sub _local_request { # 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 @@ -402,7 +406,7 @@ sub _customize_request { my $request = shift; my $extra_env = shift; my $opts = pop(@_) || {}; - $opts = {} unless ref($opts) eq 'HASH'; + $opts = {} unless is_plain_hashref($opts); if ( my $host = exists $opts->{host} ? $opts->{host} : $default_host ) { $request->header( 'Host' => $host ); }