[Catalyst-commits] r13705 - in Catalyst-Runtime/5.80/trunk: lib t/aggregate t/lib/TestApp/Controller/Action

[nine at dev.catalyst.perl.org]

Author: nine
Date: 2010-11-19 12:08:17 +0000 (Fri, 19 Nov 2010)
New Revision: 13705

Modified:
   Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
   Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_action_streaming.t
   Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Action/Streaming.pm
Log:
Fix passing file GLOBs to $c->res->body

Contrary to the documentation of Catalyst::Response, passing a
filehandle GLOB did not work, since the content-length header was not
computed correctly.

body checked if it was passed a blessed object and only then use stat
to get the file size. In all other cases the passed thing was considered
a string and length was used. Filehandle GLOBs are neither blessed nor
strings, so the content-length header always got set to 15 (length of a
stringified GLOB: "GLOB(0x123456)").


Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2010-11-18 22:47:08 UTC (rev 13704)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2010-11-19 12:08:17 UTC (rev 13705)
@@ -1858,7 +1858,7 @@
     if ( $response->body && !$response->content_length ) {
 
         # get the length from a filehandle
-        if ( blessed( $response->body ) && $response->body->can('read') )
+        if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
         {
             my $stat = stat $response->body;
             if ( $stat && $stat->size > 0 ) {

Modified: Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_action_streaming.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_action_streaming.t	2010-11-18 22:47:08 UTC (rev 13704)
+++ Catalyst-Runtime/5.80/trunk/t/aggregate/live_component_controller_action_streaming.t	2010-11-19 12:08:17 UTC (rev 13705)
@@ -10,7 +10,7 @@
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 15*$iters;
+use Test::More tests => 20*$iters;
 use Catalyst::Test 'TestApp';
 
 if ( $ENV{CAT_BENCHMARK} ) {
@@ -51,14 +51,14 @@
   SKIP:
     {
         if ( $ENV{CATALYST_SERVER} ) {
-            skip "Using remote server", 5;
+            skip "Using remote server", 10;
         }
 
         my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm";
         my $fh = IO::File->new( $file, 'r' );
         my $buffer;
         if ( defined $fh ) {
-            $fh->read( $buffer, 1024 );
+            $fh->read( $buffer, 2048 );
             $fh->close;
         }
 
@@ -68,6 +68,13 @@
         is( $response->content_type, 'text/plain', 'Response Content-Type' );
         is( $response->content_length, -s $file, 'Response Content-Length' );
         is( $response->content, $buffer, 'Content is read from filehandle' );
+
+        ok( $response = request('http://localhost/action/streaming/body_glob'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->content_length, -s $file, 'Response Content-Length' );
+        is( $response->content, $buffer, 'Content is read from filehandle' );
     }
 
     {

Modified: Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Action/Streaming.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Action/Streaming.pm	2010-11-18 22:47:08 UTC (rev 13704)
+++ Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Action/Streaming.pm	2010-11-19 12:08:17 UTC (rev 13705)
@@ -27,6 +27,19 @@
     }
 }
 
+sub body_glob : Local {
+    my ( $self, $c ) = @_;
+
+    my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm";
+    open my $fh, '<', $file;
+    if ( defined $fh ) {
+        $c->res->body( $fh );
+    }
+    else {
+        $c->res->body( "Unable to read $file" );
+    }
+}
+
 sub body_large : Local {
     my ($self, $c) = @_;