r9710@zaphod (orig r6123): andyg | 2007-02-28 17:45:31 +1100

diff --git a/Changes b/Changes

index 12a52d9..b4e09ea 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 This file documents the revision history for Perl extension Catalyst.
 
 5.7007  ??
+        - Performance and stability improvements to the built-in HTTP server.
+        - Built-in server no longer supports -k (keep-alive).
         - Don't ignore file uploads if form contains a text field with the same name.
           (Carl Franks)
         - Support restart_delay of 0 (for use in the POE engine).
diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm

index e1682af..8eb4dc3 100644 (file)
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -5,6 +5,7 @@ use base 'Catalyst::Engine::CGI';
 use Data::Dump qw(dump);
 use Errno 'EWOULDBLOCK';
 use HTTP::Date ();
+use HTTP::Headers;
 use HTTP::Status;
 use NEXT;
 use Socket;
@@ -53,17 +54,18 @@ sub finalize_headers {
     my $status   = $c->response->status;
     my $message  = status_message($status);
     
-    print "$protocol $status $message\015\012";
+    my @headers;
+    push @headers, "$protocol $status $message";
     
     $c->response->headers->header( Date => HTTP::Date::time2str(time) );
-    $c->response->headers->header(
-        Connection => $self->_keep_alive ? 'keep-alive' : 'close' );
-        
+    $c->response->headers->header( Connection => 'close' );
     $c->response->headers->header( Status => $status );
-        
-    # Avoid 'print() on closed filehandle Remote' warnings when using IE
-    print $c->response->headers->as_string("\015\012") if *STDOUT->opened();
-    print "\015\012" if *STDOUT->opened();
+    
+    push @headers, $c->response->headers->as_string("\x0D\x0A");
+    
+    # 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, '');
 }
 
 =head2 $self->finalize_read($c)
@@ -240,12 +242,20 @@ sub run {
 
             Remote->blocking(1);
         
-            # Read until we see all headers
+            # Read until we see a newline
             $self->{inputbuf} = '';
+        
+            while (1) {
+                my $read = sysread Remote, my $buf, CHUNKSIZE;
+            
+                if ( !$read ) {
+                    DEBUG && warn "EOF or error: $!\n";
+                    next LISTEN;
+                }
             
-            if ( !$self->_read_headers ) {
-                # Error reading, give up
-                next LISTEN;
+                DEBUG && warn "Read $read bytes\n";
+                $self->{inputbuf} .= $buf;
+                last if $self->{inputbuf} =~ /(\x0D\x0A?|\x0A\x0D?)/s;
             }
 
             my ( $method, $uri, $protocol ) = $self->_parse_request_line;
@@ -327,82 +337,36 @@ sub _handler {
     $sel->add( \*STDIN );
     
     REQUEST:
-    while (1) {
-        my ( $path, $query_string ) = split /\?/, $uri, 2;
-
-        # Initialize CGI environment
-        local %ENV = (
-            PATH_INFO       => $path         || '',
-            QUERY_STRING    => $query_string || '',
-            REMOTE_ADDR     => $sockdata->{peeraddr},
-            REMOTE_HOST     => $sockdata->{peername},
-            REQUEST_METHOD  => $method || '',
-            SERVER_NAME     => $sockdata->{localname},
-            SERVER_PORT     => $port,
-            SERVER_PROTOCOL => "HTTP/$protocol",
-            %copy_of_env,
-        );
-
-        # Parse headers
-        if ( $protocol >= 1 ) {
-            $self->_parse_headers;
-        }
-
-        # Pass flow control to Catalyst
-        $class->handle_request;
-    
-        DEBUG && warn "Request done\n";
-    
-        # Allow keepalive requests, this is a hack but we'll support it until
-        # the next major release.
-        if ( delete $self->{_keepalive} ) {
-            
-            DEBUG && warn "Reusing previous connection for keep-alive request\n";
-            
-            if ( $sel->can_read(1) ) {            
-                if ( !$self->_read_headers ) {
-                    # Error reading, give up
-                    last REQUEST;
-                }
+    my ( $path, $query_string ) = split /\?/, $uri, 2;
+
+    # Initialize CGI environment
+    local %ENV = (
+        PATH_INFO       => $path         || '',
+        QUERY_STRING    => $query_string || '',
+        REMOTE_ADDR     => $sockdata->{peeraddr},
+        REMOTE_HOST     => $sockdata->{peername},
+        REQUEST_METHOD  => $method || '',
+        SERVER_NAME     => $sockdata->{localname},
+        SERVER_PORT     => $port,
+        SERVER_PROTOCOL => "HTTP/$protocol",
+        %copy_of_env,
+    );
 
-                ( $method, $uri, $protocol ) = $self->_parse_request_line;
-                
-                DEBUG && warn "Parsed request: $method $uri $protocol\n";
-                
-                # Force HTTP/1.0
-                $protocol = '1.0';
-                
-                next REQUEST;
-            }
-            
-            DEBUG && warn "No keep-alive request within 1 second\n";
-        }
-        
-        last REQUEST;
+    # Parse headers
+    if ( $protocol >= 1 ) {
+        $self->_parse_headers;
     }
-    
-    DEBUG && warn "Closing connection\n";
-
-    close Remote;
-}
 
-sub _read_headers {
-    my $self = shift;
-    
-    while (1) {
-        my $read = sysread Remote, my $buf, CHUNKSIZE;
-    
-        if ( !$read ) {
-            DEBUG && warn "EOF or error: $!\n";
-            return;
-        }
+    # Pass flow control to Catalyst
+    $class->handle_request;
     
-        DEBUG && warn "Read $read bytes\n";
-        $self->{inputbuf} .= $buf;
-        last if $self->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
-    }
+    DEBUG && warn "Request done\n";
     
-    return 1;
+    # XXX: We used to have a hack for keep-alive here but keep-alive
+    # has no place in a single-tasking server like this.  Use HTTP::POE
+    # if you want keep-alive.
+
+    close Remote;
 }
 
 sub _parse_request_line {
Changes		patch \| blob \| blame \| history
lib/Catalyst/Engine/HTTP.pm		patch \| blob \| blame \| history