Fixed a bug with the HTTP engine where very large response bodies would not be sent...

diff --git a/Changes b/Changes
index 1f5ef4d..ac66fc7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -16,6 +16,8 @@ This file documents the revision history for Perl extension Catalyst.
           (http://rt.cpan.org/Ticket/Display.html?id=27135)
         - Remove warning for captures that are undef.
         - Fixed $c->read and parse_on_demand mode.
+        - Fixed a bug with the HTTP engine where very large response bodies
+          would not be sent properly.
 
 5.7007  2007-03-13 14:18:00
         - Many performance improvements by not using URI.pm:

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 0f801aa..347f781 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -4,6 +4,7 @@ use strict;
 use base 'Class::Accessor::Fast';
 use CGI::Simple::Cookie;
 use Data::Dump qw/dump/;
+use Errno 'EWOULDBLOCK';
 use HTML::Entities;
 use HTTP::Body;
 use HTTP::Headers;
@@ -609,7 +610,7 @@ sub run { }
 
 =head2 $self->write($c, $buffer)
 
-Writes the buffer to the client. Can only be called once for a request.
+Writes the buffer to the client.
 
 =cut
 
@@ -620,8 +621,27 @@ sub write {
         $self->prepare_write($c);
         $self->{_prepared_write} = 1;
     }
-
-    print STDOUT $buffer;
+    
+    my $len   = length($buffer);
+    my $wrote = syswrite STDOUT, $buffer;
+    
+    if ( defined $wrote && $wrote < $len ) {
+        # We didn't write the whole buffer
+        while (1) {
+            my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
+            if ( defined $ret ) {
+                $wrote += $ret;
+            }
+            else {
+                next if $! == EWOULDBLOCK;
+                return;
+            }
+            
+            last if $wrote >= $len;
+        }
+    }
+    
+    return $wrote;
 }
 
 =head2 $self->unescape_uri($uri)

diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm
index 2ee2e01..8ceaef1 100644 (file)
--- a/lib/Catalyst/Engine/CGI.pm
+++ b/lib/Catalyst/Engine/CGI.pm
@@ -42,7 +42,8 @@ sub finalize_headers {
 
     $c->response->header( Status => $c->response->status );
 
-    print $c->response->headers->as_string("\015\012") . "\015\012";
+    $self->{_header_buf} 
+        = $c->response->headers->as_string("\015\012") . "\015\012";
 }
 
 =head2 $self->prepare_connection($c)
@@ -207,6 +208,23 @@ sub prepare_write {
     $self->NEXT::prepare_write($c);
 }
 
+=head2 $self->write($c, $buffer)
+
+Writes the buffer to the client.
+
+=cut
+
+sub write {
+    my ( $self, $c, $buffer ) = @_;
+
+    # Prepend the headers if they have not yet been sent
+    if ( my $headers = delete $self->{_header_buf} ) {
+        $buffer = $headers . $buffer;
+    }
+    
+    return $self->NEXT::write( $c, $buffer );
+}
+
 =head2 $self->read_chunk($c, $buffer, $length)
 
 =cut

diff --git a/lib/Catalyst/Engine/FastCGI.pm b/lib/Catalyst/Engine/FastCGI.pm
index 1ac5a35..9a74c17 100644 (file)
--- a/lib/Catalyst/Engine/FastCGI.pm
+++ b/lib/Catalyst/Engine/FastCGI.pm
@@ -159,6 +159,15 @@ sub write {
         $self->prepare_write($c);
         $self->{_prepared_write} = 1;
     }
+    
+    # XXX: We can't use Engine's write() method because syswrite
+    # appears to return bogus values instead of the number of bytes
+    # written: http://www.fastcgi.com/om_archive/mail-archive/0128.html
+    
+    # Prepend the headers if they have not yet been sent
+    if ( my $headers = delete $self->{_header_buf} ) {
+        $buffer = $headers . $buffer;
+    }
 
     # FastCGI does not stream data properly if using 'print $handle',
     # but a syswrite appears to work properly.

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index 497ab90..ee4f81c 100644 (file)
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -142,7 +142,7 @@ sub read_chunk {
 
 =head2 $self->write($c, $buffer)
 
-Writes the buffer to the client. Can only be called once for a request.
+Writes the buffer to the client.
 
 =cut
 
@@ -152,19 +152,16 @@ sub write {
     # Avoid 'print() on closed filehandle Remote' warnings when using IE
     return unless *STDOUT->opened();
 
-    my $ret;
-
     # Prepend the headers if they have not yet been sent
     if ( my $headers = delete $self->{_header_buf} ) {
-        DEBUG && warn "write: Wrote headers and first chunk (" . length($headers . $buffer) . " bytes)\n";
-        $ret = $self->NEXT::write( $c, $headers . $buffer );
-    }
-    else {
-        DEBUG && warn "write: Wrote chunk (" . length($buffer) . " bytes)\n";
-        $ret = $self->NEXT::write( $c, $buffer );
+        $buffer = $headers . $buffer;
     }
     
-    if ( !$ret ) {
+    my $ret = $self->NEXT::write( $c, $buffer );
+    
+    DEBUG && warn "write: Wrote response ($ret bytes)\n";
+    
+    if ( !defined $ret ) {
         $self->{_write_error} = $!;
     }