From: Tomas Doran <bobtfish@bobtfish.net>
Date: Mon, 23 Nov 2009 21:25:19 +0000 (+0000)
Subject: Don't do bytes::length, just use length, tests to demonstrate the issue
X-Git-Tag: 5.80014_02~10^2~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=5ab21903f27011f38ec3e32ef2e649065e7adc1e;hp=2b3bb2806431cb2777075779d6bfe59e0885cdc1

Don't do bytes::length, just use length, tests to demonstrate the issue
---

diff --git a/Changes b/Changes
index acda323..626944e 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+  Bug fixes:
+   - Fix reporting the wrong Content-Length if the response body is an
+     upgraded string. Strings mean the same thing whether or not they are
+     upgraded, may get upgraded even after they are encoded, and will
+     produce the same output either way, but bytes::length returns too big
+     values for upgraded strings containing characters >127
+
   Refactoring / cleanups:
    - NoTabs and Pod tests moved to t/author so that they're not run
      (and then skipped) normally.
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 2c16800..ef3d082 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -4,7 +4,6 @@ use Moose;
 use Moose::Meta::Class ();
 extends 'Catalyst::Component';
 use Moose::Util qw/find_meta/;
-use bytes;
 use B::Hooks::EndOfScope ();
 use Catalyst::Exception;
 use Catalyst::Exception::Detach;
@@ -1793,7 +1792,7 @@ sub finalize_headers {
         }
         else {
             # everything should be bytes at this point, but just in case
-            $response->content_length( bytes::length( $response->body ) );
+            $response->content_length( length( $response->body ) );
         }
     }
 
diff --git a/t/aggregate/utf8_content_length.t b/t/aggregate/utf8_content_length.t
new file mode 100644
index 0000000..86297e8
--- /dev/null
+++ b/t/aggregate/utf8_content_length.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+use File::Spec;
+use Test::More;
+
+use Catalyst::Test qw/TestAppEncoding/;
+
+if ( $ENV{CATALYST_SERVER} ) {
+    plan skip_all => 'This test does not run live';
+    exit 0;
+}
+
+my $fn = "$Bin/../catalyst_130pix.gif";
+ok -r $fn, 'Can read catalyst_130pix.gif';
+my $size = -s $fn;
+{
+    my $r = request('/binary');
+    is $r->code, 200, '/binary OK';
+    is $r->header('Content-Length'), $size, '/binary correct content length';
+}
+{
+    my $r = request('/binary_utf8');
+    is $r->code, 200, '/binary_utf8 OK';
+    is $r->header('Content-Length'), $size, '/binary_utf8 correct content length';
+}
+
+done_testing;
+
diff --git a/t/lib/TestApp/Controller/Root.pm b/t/lib/TestApp/Controller/Root.pm
index 5aa03dc..5b29201 100644
--- a/t/lib/TestApp/Controller/Root.pm
+++ b/t/lib/TestApp/Controller/Root.pm
@@ -1,5 +1,6 @@
 package TestApp::Controller::Root;
-
+use strict;
+use warnings;
 use base 'Catalyst::Controller';
 
 __PACKAGE__->config->{namespace} = '';
diff --git a/t/lib/TestAppEncoding.pm b/t/lib/TestAppEncoding.pm
new file mode 100644
index 0000000..53f50ff
--- /dev/null
+++ b/t/lib/TestAppEncoding.pm
@@ -0,0 +1,11 @@
+package TestAppEncoding;
+use strict;
+use warnings;
+use base qw/Catalyst/;
+use Catalyst;
+
+__PACKAGE__->config(name => __PACKAGE__);
+__PACKAGE__->setup;
+
+1;
+
diff --git a/t/lib/TestAppEncoding/Controller/Root.pm b/t/lib/TestAppEncoding/Controller/Root.pm
new file mode 100644
index 0000000..b5b3eeb
--- /dev/null
+++ b/t/lib/TestAppEncoding/Controller/Root.pm
@@ -0,0 +1,27 @@
+package TestAppEncoding::Controller::Root;
+use strict;
+use warnings;
+use base 'Catalyst::Controller';
+use Test::More;
+
+__PACKAGE__->config->{namespace} = '';
+
+sub binary : Local {
+    my ($self, $c) = @_;
+    $c->res->body(do { open(my $fh, '<', $c->path_to('..', '..', 'catalyst_130pix.gif')) or die $!; local $/ = undef; <$fh>; });
+}
+
+sub binary_utf8 : Local {
+    my ($self, $c) = @_;
+    $c->forward('binary');
+    my $str = $c->res->body;
+    utf8::upgrade($str);
+    ok utf8::is_utf8($str), 'Body is variable width encoded string';
+    $c->res->body($str);
+}
+
+sub end : Private {
+    my ($self,$c) = @_;
+}
+
+1;