[Catalyst-commits] r7457 - in trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP: . Prefork

[andyg at dev.catalyst.perl.org]

Author: andyg
Date: 2008-02-26 05:24:12 +0000 (Tue, 26 Feb 2008)
New Revision: 7457

Modified:
   trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm
   trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm
Log:
HTTP::Prefork, fix a few bugs

Modified: trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm	2008-02-23 16:37:48 UTC (rev 7456)
+++ trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm	2008-02-26 05:24:12 UTC (rev 7457)
@@ -8,6 +8,7 @@
 use HTTP::Date qw(time2str);
 use HTTP::Headers;
 use HTTP::Status qw(status_message);
+use IO::Socket qw(:crlf);
 
 use constant DEBUG     => $ENV{CATALYST_PREFORK_DEBUG} || 0;
 use constant CHUNKSIZE => 64 * 1024;
@@ -101,11 +102,13 @@
     if ( $_[0] = $self->{client}->{inputbuf} ) {
         $read = length( $_[0] );
         $self->{client}->{inputbuf} = '';
-        DEBUG && warn "[$$] read_chunk: Read $read bytes from previous input buffer: " . dump($_[0]) . "\n";
+        
+        # XXX: Data::Dump segfaults on 5.8.8 when dumping long strings...
+        DEBUG && warn "[$$] read_chunk: Read $read bytes from previous input buffer\n"; # . dump($_[0]) . "\n";
     }
     else {
         $read = $self->SUPER::read_chunk( $c, @_ );
-        DEBUG && warn "[$$] read_chunk: Read $read bytes from STDIN: " . dump($_[0]) . "\n";
+        DEBUG && warn "[$$] read_chunk: Read $read bytes from STDIN\n"; # . dump($_[0]) . "\n";
     }
     
     return $read;
@@ -152,11 +155,11 @@
         $c->response->headers->header( Connection => 'close' );
     }
     
-    push @headers, $c->response->headers->as_string("\x0D\x0A");
+    push @headers, $c->response->headers->as_string($CRLF);
     
     # Buffer the headers so they are sent with the first write() call
     # This reduces the number of TCP packets we are sending
-    $self->{_header_buf} = join("\x0D\x0A", @headers, '');
+    $self->{_header_buf} = join( $CRLF, @headers, '' );
 }
 
 sub finalize_body {
@@ -167,7 +170,7 @@
     if ( $self->{_chunked_res} ) {
         if ( !$self->{_chunked_done} ) {
             # Write the final '0' chunk
-            syswrite STDOUT, "0\x0D\x0A";
+            syswrite STDOUT, "0$CRLF";
         }
         
         delete $self->{_chunked_res};
@@ -181,7 +184,7 @@
     if ( $self->{_chunked_res} ) {
         my $len = length($buffer);
         
-        $buffer = sprintf( "%x", $len ) . "\x0D\x0A" . $buffer . "\x0D\x0A";
+        $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
         
         # Flag if we wrote an empty chunk
         if ( !$len ) {

Modified: trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm	2008-02-23 16:37:48 UTC (rev 7456)
+++ trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm	2008-02-26 05:24:12 UTC (rev 7457)
@@ -9,6 +9,7 @@
 use HTTP::Response;
 use HTTP::Status qw(status_message);
 use IO::Select;
+use IO::Socket qw(:crlf);
 use Perlbal::XS::HTTPHeaders;
 use Perlbal::HTTPHeaders;
 use Socket;
@@ -186,19 +187,19 @@
     eval {
         local $SIG{ALRM} = sub { die "Timed out\n"; };
         
-        my $previous_alarm = alarm( READ_TIMEOUT );
+        alarm( READ_TIMEOUT );
         
         while (1) {
             # Do we have a full header in the buffer?
             # This is before sysread so we don't read if we have a pipelined request
             # waiting in the buffer
-            last if $self->{client}->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
+            last if $self->{client}->{inputbuf} =~ /$CRLF$CRLF/s;
             
             # If not, read some data
             my $read = sysread STDIN, my $buf, CHUNKSIZE;
     
             if ( !defined $read || $read == 0 ) {
-                die "Read error\n";
+                die "Read error: $!\n";
             }
     
             if ( DEBUG ) {
@@ -207,25 +208,27 @@
             
             $self->{client}->{inputbuf} .= $buf;
         }
-        
-        alarm( $previous_alarm );
     };
     
-    if ( $@ =~ /Timed out/ ) {
-        DEBUG && warn "[$$] Client connection timed out\n";
-        return;
-    }
+    alarm(0);
     
-    if ( $@ =~ /Read error/ ) {
-        DEBUG && warn "[$$] Read error: $!\n";
-        return;
+    if ( $@ ) {
+        if ( $@ =~ /Timed out/ ) {
+            DEBUG && warn "[$$] Client connection timed out\n";
+            return;
+        }
+    
+        if ( $@ =~ /Read error/ ) {
+            DEBUG && warn "[$$] Read error: $!\n";
+            return;
+        }
     }
     
     # Pull out the complete header into a new buffer
     $self->{client}->{headerbuf} = $self->{client}->{inputbuf};
     
     # Save any left-over data, possibly body data or pipelined requests
-    $self->{client}->{inputbuf} =~ s/.*?(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)//s;
+    $self->{client}->{inputbuf} =~ s/.*?$CRLF$CRLF//s;
     
     return 1;
 }
@@ -247,7 +250,7 @@
 
     $response->content( "$status $reason" );
 
-    syswrite STDOUT, $response->as_string("\x0D\x0A");
+    syswrite STDOUT, $response->as_string($CRLF);
 }
 
 1;