Improve performance by skipping body processing if we don't have Content-Length

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine.pm

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index f075890..01b60c1 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -312,29 +312,35 @@ sets up the L<Catalyst::Request> object body using L<HTTP::Body>
 
 sub prepare_body {
     my ( $self, $c ) = @_;
+    
+    my $length = $c->request->header('Content-Length') || 0;
 
-    $self->read_length( $c->request->header('Content-Length') || 0 );
-    my $type = $c->request->header('Content-Type');
-
-    unless ( $c->request->{_body} ) {
-        $c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
-        $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
-          if exists $c->config->{uploadtmp};
-    }
+    $self->read_length( $length );
 
-    if ( $self->read_length > 0 ) {
+    if ( $length > 0 ) {
+        unless ( $c->request->{_body} ) {
+            my $type = $c->request->header('Content-Type');
+            $c->request->{_body} = HTTP::Body->new( $type, $length );
+            $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
+              if exists $c->config->{uploadtmp};
+        }
+        
         while ( my $buffer = $self->read($c) ) {
             $c->prepare_body_chunk($buffer);
         }
 
         # paranoia against wrong Content-Length header
-        my $remaining = $self->read_length - $self->read_position;
+        my $remaining = $length - $self->read_position;
         if ( $remaining > 0 ) {
             $self->finalize_read($c);
             Catalyst::Exception->throw(
-                "Wrong Content-Length value: " . $self->read_length );
+                "Wrong Content-Length value: $length" );
         }
     }
+    else {
+        # Defined but will cause all body code to be skipped
+        $c->request->{_body} = 0;
+    }
 }
 
 =head2 $self->prepare_body_chunk($c)
@@ -357,6 +363,9 @@ Sets up parameters from body.
 
 sub prepare_body_parameters {
     my ( $self, $c ) = @_;
+    
+    return unless $c->request->{_body};
+    
     $c->request->body_parameters( $c->request->{_body}->param );
 }
 
@@ -476,6 +485,9 @@ sub prepare_request { }
 
 sub prepare_uploads {
     my ( $self, $c ) = @_;
+    
+    return unless $c->request->{_body};
+    
     my $uploads = $c->request->{_body}->upload;
     for my $name ( keys %$uploads ) {
         my $files = $uploads->{$name};
@@ -494,8 +506,20 @@ sub prepare_uploads {
 
         # support access to the filename as a normal param
         my @filenames = map { $_->{filename} } @uploads;
-        $c->request->parameters->{$name} =
-          @filenames > 1 ? \@filenames : $filenames[0];
+        # append, if there's already params with this name
+        if (exists $c->request->parameters->{$name}) {
+            if (ref $c->request->parameters->{$name} eq 'ARRAY') {
+                push @{ $c->request->parameters->{$name} }, @filenames;
+            }
+            else {
+                $c->request->parameters->{$name} = 
+                    [ $c->request->parameters->{$name}, @filenames ];
+            }
+        }
+        else {
+            $c->request->parameters->{$name} =
+                @filenames > 1 ? \@filenames : $filenames[0];
+        }
     }
 }
 
@@ -579,8 +603,6 @@ sub write {
         $self->prepare_write($c);
         $self->{_prepared_write} = 1;
     }
-    
-    return unless *STDOUT->opened();
 
     print STDOUT $buffer;
 }