[Catalyst-commits] r13466 - in Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href: . lib/Catalyst t t/lib/TestApp/Controller

Tue Aug 3 20:56:42 GMT 2010

Author: rjk
Date: 2010-08-03 21:56:42 +0100 (Tue, 03 Aug 2010)
New Revision: 13466

Modified:
   Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/Makefile.PL
   Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/lib/Catalyst/Test.pm
   Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/lib/TestApp/Controller/Root.pm
   Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/live_catalyst_test.t
Log:
Make Catalyst::Test::local_request() set response base from base href (requires HTML::HeadParser)


Modified: Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/Makefile.PL
===================================================================

--- Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/Makefile.PL	2010-08-03 18:24:54 UTC (rev 13465)
+++ Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/Makefile.PL	2010-08-03 20:56:42 UTC (rev 13466)
@@ -28,6 +28,7 @@
 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';

Modified: Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/lib/Catalyst/Test.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/lib/Catalyst/Test.pm	2010-08-03 18:24:54 UTC (rev 13465)
+++ Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/lib/Catalyst/Test.pm	2010-08-03 20:56:42 UTC (rev 13466)
@@ -239,6 +239,21 @@
 
     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;
 }
 

Modified: Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/lib/TestApp/Controller/Root.pm	2010-08-03 18:24:54 UTC (rev 13465)
+++ Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/lib/TestApp/Controller/Root.pm	2010-08-03 20:56:42 UTC (rev 13466)
@@ -49,6 +49,22 @@
     $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) = @_;
 }

Modified: Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/live_catalyst_test.t
===================================================================
--- Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/live_catalyst_test.t	2010-08-03 18:24:54 UTC (rev 13465)
+++ Catalyst-Runtime/5.80/branches/Catalyst-Test-base-href/t/live_catalyst_test.t	2010-08-03 20:56:42 UTC (rev 13466)
@@ -3,7 +3,7 @@
 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_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';
 


