[Catalyst-commits] r6617 - in trunk/Catalyst-Runtime: . lib/Catalyst lib/Catalyst/Engine

[andyg at dev.catalyst.perl.org]

Author: andyg
Date: 2007-08-03 17:32:53 +0100 (Fri, 03 Aug 2007)
New Revision: 6617

Modified:
   trunk/Catalyst-Runtime/Changes
   trunk/Catalyst-Runtime/lib/Catalyst/Engine.pm
   trunk/Catalyst-Runtime/lib/Catalyst/Engine/CGI.pm
   trunk/Catalyst-Runtime/lib/Catalyst/Engine/FastCGI.pm
   trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm
Log:
Fixed a bug with the HTTP engine where very large response bodies would not be sent properly

Modified: trunk/Catalyst-Runtime/Changes
===================================================================
--- trunk/Catalyst-Runtime/Changes	2007-08-03 16:30:21 UTC (rev 6616)
+++ trunk/Catalyst-Runtime/Changes	2007-08-03 16:32:53 UTC (rev 6617)
@@ -16,6 +16,8 @@
           (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:

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Engine/CGI.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Engine/CGI.pm	2007-08-03 16:30:21 UTC (rev 6616)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Engine/CGI.pm	2007-08-03 16:32:53 UTC (rev 6617)
@@ -42,7 +42,8 @@
 
     $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 @@
     $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

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Engine/FastCGI.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Engine/FastCGI.pm	2007-08-03 16:30:21 UTC (rev 6616)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Engine/FastCGI.pm	2007-08-03 16:32:53 UTC (rev 6617)
@@ -159,6 +159,15 @@
         $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.

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm	2007-08-03 16:30:21 UTC (rev 6616)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm	2007-08-03 16:32:53 UTC (rev 6617)
@@ -142,7 +142,7 @@
 
 =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 @@
     # 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 );
+        $buffer = $headers . $buffer;
     }
-    else {
-        DEBUG && warn "write: Wrote chunk (" . length($buffer) . " bytes)\n";
-        $ret = $self->NEXT::write( $c, $buffer );
-    }
     
-    if ( !$ret ) {
+    my $ret = $self->NEXT::write( $c, $buffer );
+    
+    DEBUG && warn "write: Wrote response ($ret bytes)\n";
+    
+    if ( !defined $ret ) {
         $self->{_write_error} = $!;
     }
     

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Engine.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Engine.pm	2007-08-03 16:30:21 UTC (rev 6616)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Engine.pm	2007-08-03 16:32:53 UTC (rev 6617)
@@ -4,6 +4,7 @@
 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 @@
 
 =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 @@
         $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)