more utf8 tests and fixes
John Napiorkowski [Tue, 2 Dec 2014 01:58:04 +0000 (19:58 -0600)]
lib/Catalyst.pm
t/aggregate/utf8_content_length.t
t/lib/TestAppEncoding/Controller/Root.pm
t/utf_incoming.t

index eaf9581..141099c 100644 (file)
@@ -2031,13 +2031,30 @@ sub finalize_headers {
 
     $c->response->finalize_headers();
 
+    if(my $enc = $c->encoding) {
+       my ($ct, $ct_enc) = $c->response->content_type;
+
+        # Only touch 'text-like' contents
+        if($c->response->content_type =~ /^text|xml$|javascript$/) {
+          if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
+            if (uc($1) ne uc($enc->mime_name)) {
+              $c->log->debug("Catalyst encoding config is set to encode in '" .
+                           $enc->mime_name .
+                           "', content type is '$1', not encoding ");
+            }
+          } else {
+            $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
+          }
+        }
+    }
+
     # Done
     $response->finalized_headers(1);
 }
 
 =head2 $c->finalize_encoding
 
-Make sure your headers and body are encoded properly IF you set an encoding.  By
+Make sure your body is encoded properly IF you set an encoding.  By
 default the encoding is UTF-8 but you can disable it by explictly setting the
 encoding configuration value to undef.
 
@@ -2056,27 +2073,12 @@ sub finalize_encoding {
 
     return unless $enc;
 
-    my ($ct, $ct_enc) = $c->response->content_type;
-
     # Only touch 'text-like' contents
-    return unless $c->response->content_type =~ /^text|xml$|javascript$/;
-
-    if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
-        if (uc($1) ne uc($enc->mime_name)) {
-            $c->log->debug("Unicode::Encoding is set to encode in '" .
-                           $enc->mime_name .
-                           "', content type is '$1', not encoding ");
-            return;
-        }
-    } else {
-        $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
+    if($c->response->content_type =~ /^text|xml$|javascript$/) {
+      if (ref(\$body) eq 'SCALAR') {
+        $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) );
+      }
     }
-
-    # Oh my, I wonder what filehandle responses and streams do... - jnap.
-    # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's
-    if (ref(\$body) eq 'SCALAR') {
-      $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) );
-    };
 }
 
 =head2 $c->finalize_output
index 64d4eb8..bf71b8e 100644 (file)
@@ -29,4 +29,3 @@ my $size = -s $fn;
 }
 
 done_testing;
-
index b82e1bf..1c42bfa 100644 (file)
@@ -8,6 +8,7 @@ __PACKAGE__->config->{namespace} = '';
 
 sub binary : Local {
     my ($self, $c) = @_;
+    $c->res->content_type('image/gif');
     $c->res->body(do {
         open(my $fh, '<', $c->path_to('..', '..', 'catalyst_130pix.gif')) or die $!; 
         binmode($fh); 
@@ -31,12 +32,8 @@ sub utf8_non_ascii_content : Local {
     
     my $str = 'ʇsʎlɐʇɐɔ';  # 'catalyst' flipped at http://www.revfad.com/flip.html
     ok utf8::is_utf8($str), '$str is in UTF8 internally';
-    
-    # encode $str into a sequence of octets and turn off the UTF-8 flag, so that
-    # we don't get the 'Wide character in syswrite' error in Catalyst::Engine
-    utf8::encode($str);
-    ok !utf8::is_utf8($str), '$str is a sequence of octets (byte string)';
-    
+
+    $c->res->content_type('text/plain');
     $c->res->body($str);
 }
 
index a06338d..7a0d94d 100644 (file)
@@ -114,6 +114,7 @@ use Catalyst::Test 'MyApp';
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
   is $res->content_length, 36, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -122,6 +123,7 @@ use Catalyst::Test 'MyApp';
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
   is $res->content_length, 40, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -130,6 +132,7 @@ use Catalyst::Test 'MyApp';
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
   is $res->content_length, 32, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -138,6 +141,7 @@ use Catalyst::Test 'MyApp';
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
   is $res->content_length, 35, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -152,6 +156,7 @@ use Catalyst::Test 'MyApp';
   is $c->req->parameters->{'♥'}[0], '♥';
   is $c->req->parameters->{a}, 1;
   is $c->req->body_parameters->{a}, 1;
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -161,6 +166,7 @@ use Catalyst::Test 'MyApp';
   is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
   is $res->content_length, 35, 'correct length';
   is $c->req->query_keywords, '♥♥♥';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -169,6 +175,7 @@ use Catalyst::Test 'MyApp';
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
   is $res->content_length, 39, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -176,6 +183,7 @@ use Catalyst::Test 'MyApp';
 
   is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
   is $res->content_length, 39, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -192,6 +200,8 @@ use Catalyst::Test 'MyApp';
     is $c->req->query_parameters->{'♥'}, '♥♥';
     is $c->req->body_parameters->{'♥'}, '♥♥';
     is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
+    is $res->content_charset, 'UTF-8';
+
   }
 }
 
@@ -203,6 +213,7 @@ use Catalyst::Test 'MyApp';
   is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
   is $res->content, "$url", 'correct body';
   is $res->content_length, 90, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -210,6 +221,7 @@ use Catalyst::Test 'MyApp';
 
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
+  is $res->content_charset, 'UTF-8';
 }
 
 {
@@ -217,6 +229,7 @@ use Catalyst::Test 'MyApp';
 
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
+  is $res->content_charset, 'UTF-8';
   # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
   # if is a problem or just an artifact of the why the test stuff works - JNAP
 }
@@ -226,7 +239,10 @@ use Catalyst::Test 'MyApp';
 
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
+  is $res->content_length, 41, 'correct length';
+  is $res->content_charset, 'UTF-8';
 }
 
-
 done_testing;
+
+MyApp->to_app;