Make Catalyst::Test::local_request() set response base from base href (requires HTML...

diff --git a/Makefile.PL b/Makefile.PL

index 3b2305c..0d021ce 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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";
+<html>
+  <head>
+    <base href="http://www.example.com/">
+  </head>
+  <body>
+  </body>
+</html>
+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 (file)
--- 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';
Makefile.PL		patch \| blob \| blame \| history
lib/Catalyst/Test.pm		patch \| blob \| blame \| history
t/lib/TestApp/Controller/Root.pm		patch \| blob \| blame \| history
t/live_catalyst_test.t		patch \| blob \| blame \| history