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

[zarquon at dev.catalyst.perl.org]

Author: zarquon
Date: 2007-04-04 03:01:04 +0100 (Wed, 04 Apr 2007)
New Revision: 6277

Modified:
   trunk/Catalyst-Runtime/Changes
   trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm
   trunk/Catalyst-Runtime/lib/Catalyst/Test.pm
Log:
fixed bodged svk push

Modified: trunk/Catalyst-Runtime/Changes
===================================================================
--- trunk/Catalyst-Runtime/Changes	2007-04-04 00:45:57 UTC (rev 6276)
+++ trunk/Catalyst-Runtime/Changes	2007-04-04 02:01:04 UTC (rev 6277)
@@ -14,7 +14,6 @@
 
 5.7007  2007-03-13 14:18:00
         - 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).

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm	2007-04-04 00:45:57 UTC (rev 6276)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Engine/HTTP.pm	2007-04-04 02:01:04 UTC (rev 6277)
@@ -57,9 +57,21 @@
     push @headers, "$protocol $status $message";
     
     $c->response->headers->header( Date => HTTP::Date::time2str(time) );
-    $c->response->headers->header( Connection => 'close' );
     $c->response->headers->header( Status => $status );
     
+    # Should we keep the connection open?
+    my $connection = $c->request->header('Connection');
+    if (   $self->{options}->{keepalive} 
+        && $connection 
+        && $connection =~ /^keep-alive$/i
+    ) {
+        $c->response->headers->header( Connection => 'keep-alive' );
+        $self->{_keepalive} = 1;
+    }
+    else {
+        $c->response->headers->header( Connection => 'close' );
+    }
+    
     push @headers, $c->response->headers->as_string("\x0D\x0A");
     
     # Buffer the headers so they are sent with the first write() call
@@ -247,20 +259,12 @@
 
             Remote->blocking(1);
         
-            # Read until we see a newline
+            # Read until we see all headers
             $self->{inputbuf} = '';
-        
-            while (1) {
-                my $read = sysread Remote, my $buf, CHUNKSIZE;
             
-                if ( !$read ) {
-                    DEBUG && warn "EOF or error: $!\n";
-                    next LISTEN;
-                }
-            
-                DEBUG && warn "Read $read bytes\n";
-                $self->{inputbuf} .= $buf;
-                last if $self->{inputbuf} =~ /(\x0D\x0A?|\x0A\x0D?)/s;
+            if ( !$self->_read_headers ) {
+                # Error reading, give up
+                next LISTEN;
             }
 
             my ( $method, $uri, $protocol ) = $self->_parse_request_line;
@@ -355,36 +359,81 @@
             %copy_of_env,
         );
 
-    # 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,
-    );
+        # 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;
-    }
+        # Parse headers
+        if ( $protocol >= 1 ) {
+            $self->_parse_headers;
+        }
 
-    # Pass flow control to Catalyst
-    $class->handle_request;
+        # Pass flow control to Catalyst
+        $class->handle_request;
     
-    DEBUG && warn "Request done\n";
+        DEBUG && warn "Request done\n";
     
-    # 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.
+        # 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;
+                }
 
+                ( $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;
+    }
+    
+    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;
+        }
+    
+        DEBUG && warn "Read $read bytes\n";
+        $self->{inputbuf} .= $buf;
+        last if $self->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
+    }
+    
+    return 1;
+}
+
 sub _parse_request_line {
     my $self = shift;
 

Modified: trunk/Catalyst-Runtime/lib/Catalyst/Test.pm
===================================================================
--- trunk/Catalyst-Runtime/lib/Catalyst/Test.pm	2007-04-04 00:45:57 UTC (rev 6276)
+++ trunk/Catalyst-Runtime/lib/Catalyst/Test.pm	2007-04-04 02:01:04 UTC (rev 6277)
@@ -147,7 +147,7 @@
         shift @sp;shift @rp; # leading /
         if (@rp) {
             foreach my $sp (@sp) {
-                $sp eq $rp[0] ? shift @rp : last
+                shift @rp if $sp eq $rp[0];
             }
         }
         $request->uri->path(join '/', @rp);