From: Ronald J Kimball Date: Tue, 3 Aug 2010 20:56:42 +0000 (+0000) Subject: Make Catalyst::Test::local_request() set response base from base href (requires HTML... X-Git-Tag: 5.80026~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=f23f16344c6e965eb8b0f31032711b2c205f1751 Make Catalyst::Test::local_request() set response base from base href (requires HTML::HeadParser) --- diff --git a/Makefile.PL b/Makefile.PL index 3b2305c..0d021ce 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -28,6 +28,7 @@ requires 'CGI::Simple::Cookie' => '1.109'; requires 'Data::Dump'; requires 'Data::OptList'; requires 'HTML::Entities'; +requires 'HTML::HeadParser'; requires 'HTTP::Body' => '1.06'; # ->cleanup(1) requires 'HTTP::Headers' => '1.64'; requires 'HTTP::Request' => '5.814'; diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index e940be0..397e98d 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -239,6 +239,21 @@ sub local_request { my $response = $cgi->restore->response; $response->request( $request ); + + # HTML head parsing based on LWP::UserAgent + + require HTML::HeadParser; + + my $parser = HTML::HeadParser->new(); + $parser->xml_mode(1) if $response->content_is_xhtml; + $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; + + $parser->parse( $response->content ); + my $h = $parser->header; + for my $f ( $h->header_field_names ) { + $response->init_header( $f, [ $h->header($f) ] ); + } + return $response; } diff --git a/t/lib/TestApp/Controller/Root.pm b/t/lib/TestApp/Controller/Root.pm index 5b29201..18c6db8 100644 --- a/t/lib/TestApp/Controller/Root.pm +++ b/t/lib/TestApp/Controller/Root.pm @@ -49,6 +49,22 @@ sub recursion_test : Local { $c->forward( 'recursion_test' ); } +sub base_href_test : Local { + my ( $self, $c ) = @_; + + my $body = <<"EndOfBody"; + + + + + + + +EndOfBody + + $c->response->body($body); +} + sub end : Private { my ($self,$c) = @_; } diff --git a/t/live_catalyst_test.t b/t/live_catalyst_test.t index f4f695e..1adecbb 100644 --- a/t/live_catalyst_test.t +++ b/t/live_catalyst_test.t @@ -3,7 +3,7 @@ use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp', {default_host => 'default.com'}; use Catalyst::Request; -use Test::More tests => 8; +use Test::More tests => 9; content_like('/',qr/root/,'content check'); action_ok('/','Action ok ok','normal action ok'); @@ -11,6 +11,12 @@ action_redirect('/engine/response/redirect/one','redirect check'); action_notfound('/engine/response/status/s404','notfound check'); contenttype_is('/action/local/one','text/plain','Contenttype check'); +### local_request() was not setting response base from base href +{ + my $response = request('/base_href_test'); + is( $response->base, 'http://www.example.com/', 'response base set from base href'); +} + my $creq; my $req = '/dump/request';