Merge branch 'patch-1' of https://github.com/daleevans/catalyst-runtime into daleevan...

diff --git a/Changes b/Changes
index adf5d1b..d842512 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90093 - 2015-05-29
+  - Fixed a bug where if you used $res->write and then $res->body, the
+    contents of body would be double encoded (gshank++).
+
 5.90092 - 2015-05-19
   - Allows you to use a namespace suffix for request, response and stats
     class traits.  Docs and tests for this.

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index c8eab05..7e12cd6 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -180,7 +180,7 @@ sub composed_stats_class {
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90092';
+our $VERSION = '5.90093';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 sub import {
@@ -2228,9 +2228,10 @@ sub finalize_encoding {
         # Set the charset if necessary.  This might be a bit bonkers since encodable response
         # is false when the set charset is not the same as the encoding mimetype (maybe 
         # confusing action at a distance here..
-        # Don't try to set the charset if one already exists
+        # Don't try to set the charset if one already exists or if headers are already finalized
         $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
-          unless($c->res->content_type_charset);
+          unless($c->res->content_type_charset ||
+                ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
     }
 }
 

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index e4deb9e..5e87e9f 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -159,11 +159,11 @@ sub finalize_body {
           }
           else {
               
-              # Case where body was set afgter calling ->write.  We'd prefer not to
+              # Case where body was set after calling ->write.  We'd prefer not to
               # support this, but I can see some use cases with the way most of the
-              # views work.
-
-              $self->write($c, $body );
+              # views work. Since body has already been encoded, we need to do
+              # an 'unencoded_write' here.
+              $self->unencoded_write( $c, $body );
           }
         }
 
@@ -700,6 +700,20 @@ sub write {
     $c->response->write($buffer);
 }
 
+=head2 $self->unencoded_write($c, $buffer)
+
+Writes the buffer to the client without encoding. Necessary for
+already encoded buffers. Used when a $c->write has been done
+followed by $c->res->body.
+
+=cut
+
+sub unencoded_write {
+    my ( $self, $c, $buffer ) = @_;
+
+    $c->response->unencoded_write($buffer);
+}
+
 =head2 $self->read($c, [$maxlength])
 
 Reads from the input stream by calling C<< $self->read_chunk >>.

diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm
index eb99ab7..fa15afb 100644 (file)
--- a/lib/Catalyst/Response.pm
+++ b/lib/Catalyst/Response.pm
@@ -134,6 +134,20 @@ sub write {
     return $len;
 }
 
+sub unencoded_write {
+    my ( $self, $buffer ) = @_;
+
+    # Finalize headers if someone manually writes output
+    $self->_context->finalize_headers unless $self->finalized_headers;
+
+    $buffer = q[] unless defined $buffer;
+
+    my $len = length($buffer);
+    $self->_writer->write($buffer);
+
+    return $len;
+}
+
 sub finalize_headers {
     my ($self) = @_;
     return;

diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm
index 7187a39..8332312 100644 (file)
--- a/lib/Catalyst/Runtime.pm
+++ b/lib/Catalyst/Runtime.pm
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90092';
+our $VERSION = '5.90093';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 =head1 NAME

diff --git a/lib/Catalyst/UTF8.pod b/lib/Catalyst/UTF8.pod
index eefb181..0f20099 100644 (file)
--- a/lib/Catalyst/UTF8.pod
+++ b/lib/Catalyst/UTF8.pod
@@ -462,6 +462,11 @@ B<NOTE> If you try to change the encoding after you start the stream, this will
 response.  However since you've already started streaming this will not show up as an HTTP error
 status code, but rather error information in your body response and an error in your logs.
 
+B<NOTE> If you use ->body AFTER using ->write (for example you may do this to write your HTML
+HEAD information as fast as possible) we expect the contents to body to be encoded as it
+normally would be if you never called ->write.  In general unless you are doing weird custom
+stuff with encoding this is likely to just already do the correct thing.
+
 The second way to stream a response is to get the response writer object and invoke methods
 on that directly:
 

diff --git a/t/utf_incoming.t b/t/utf_incoming.t
index 6342025..ff61a6b 100644 (file)
--- a/t/utf_incoming.t
+++ b/t/utf_incoming.t
@@ -111,6 +111,14 @@ use Scalar::Util ();
     $c->response->body($contents);
   }
 
+  sub write_then_body :Local {
+    my ($self, $c) = @_;
+
+    $c->res->content_type('text/html');
+    $c->res->write("<p>This is early_write action ♥</p>");
+    $c->res->body("<p>This is body_write action ♥</p>");
+  }
+
   sub file_upload :POST  Consumes(Multipart) Local {
     my ($self, $c) = @_;
     Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
@@ -365,6 +373,14 @@ use Catalyst::Test 'MyApp';
 }
 
 {
+  my $res = request "/root/write_then_body";
+
+  is $res->code, 200, 'OK';
+  is decode_utf8($res->content), "<p>This is early_write action ♥</p><p>This is body_write action ♥</p>";
+  is $res->content_charset, 'UTF-8';
+}
+
+{
   ok my $path = File::Spec->catfile('t', 'utf8.txt');
   ok my $req = POST '/root/file_upload',
     Content_Type => 'form-data',