- Improved: Params handling with MP engines

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

diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm
index 29b8421..fbb6c48 100644 (file)
--- a/lib/Catalyst/Engine/CGI.pm
+++ b/lib/Catalyst/Engine/CGI.pm
@@ -2,12 +2,10 @@ package Catalyst::Engine::CGI;
 
 use strict;
 use base 'Catalyst::Engine';
-use URI;
-
-require CGI::Simple;
 
-$CGI::Simple::POST_MAX        = 1048576;
-$CGI::Simple::DISABLE_UPLOADS = 0;
+use CGI;
+use URI;
+use URI::http;
 
 __PACKAGE__->mk_accessors('cgi');
 
@@ -33,7 +31,7 @@ appropriate engine module.
 =head1 DESCRIPTION
 
 This is the Catalyst engine specialized for the CGI environment (using the
-C<CGI::Simple> and C<CGI::Cookie> modules).  Normally Catalyst will select the
+C<CGI> and C<CGI::Cookie> modules).  Normally Catalyst will select the
 appropriate engine according to the environment that it detects, however you
 can force Catalyst to use the CGI engine by specifying the following in your
 application module:
@@ -49,7 +47,7 @@ useful in production applications, but it may be helpful for development.
 
 =item $c->cgi
 
-This config parameter contains the C<CGI::Simple> object.
+This config parameter contains the C<CGI> object.
 
 =back
 
@@ -59,32 +57,42 @@ This class overloads some methods from C<Catalyst::Engine>.
 
 =over 4
 
+=item $c->finalize_body
+
+Prints the response output to STDOUT.
+
+=cut
+
+sub finalize_body {
+    my $c = shift;
+    print $c->response->output;
+}
+
 =item $c->finalize_headers
 
 =cut
 
 sub finalize_headers {
     my $c = shift;
-    my %headers;
 
-    $headers{-status} = $c->response->status if $c->response->status;
+    $c->response->header( Status => $c->response->status );
 
-    for my $name ( $c->response->headers->header_field_names ) {
-        $headers{"-$name"} = $c->response->header($name);
-    }
-
-    print $c->cgi->header(%headers);
+    print $c->response->headers->as_string("\015\012");
+    print "\015\012";
 }
 
-=item $c->finalize_output
-
-Prints the response output to STDOUT.
+=item $c->prepare_body
 
 =cut
 
-sub finalize_output {
+sub prepare_body {
     my $c = shift;
-    print $c->response->output;
+
+    # XXX this is undocumented in CGI.pm. If Content-Type is not
+    # application/x-www-form-urlencoded or multipart/form-data
+    # CGI.pm will read STDIN into a param, POSTDATA.
+
+    $c->request->body( $c->cgi->param('POSTDATA') );
 }
 
 =item $c->prepare_connection
@@ -93,8 +101,8 @@ sub finalize_output {
 
 sub prepare_connection {
     my $c = shift;
-    $c->req->hostname( $c->cgi->remote_host );
-    $c->req->address( $c->cgi->remote_addr );
+    $c->req->hostname( $ENV{REMOTE_HOST} );
+    $c->req->address( $ENV{REMOTE_ADDR} );
 }
 
 =item $c->prepare_headers
@@ -103,13 +111,17 @@ sub prepare_connection {
 
 sub prepare_headers {
     my $c = shift;
-    $c->req->method( $c->cgi->request_method );
-    for my $header ( $c->cgi->http ) {
+
+    while ( my ( $header, $value ) = each %ENV ) {
+
+        next unless $header =~ /^(HTTP|CONTENT)/i;
+
         ( my $field = $header ) =~ s/^HTTPS?_//;
-        $c->req->headers->header( $field => $c->cgi->http($header) );
+
+        $c->req->headers->header( $field => $value );
     }
-    $c->req->headers->header( 'Content-Type'   => $c->cgi->content_type );
-    $c->req->headers->header( 'Content-Length' => $c->cgi->content_length );
+
+    $c->req->method( $ENV{REQUEST_METHOD} || 'GET' );
 }
 
 =item $c->prepare_parameters
@@ -117,16 +129,27 @@ sub prepare_headers {
 =cut
 
 sub prepare_parameters {
-    my $c    = shift;
+    my $c = shift;
+    
+    my ( @params );
+    
+    
+    if ( $c->request->method eq 'POST' ) {
+
+        for my $param ( $c->cgi->url_param ) {
+            for my $value (  $c->cgi->url_param($param) ) {
+                push ( @params, $param, $value );
+            }
+        }
+    }
 
-    $c->cgi->parse_query_string;
- 
-    my %vars = $c->cgi->Vars;
-    while ( my ( $key, $value ) = each %vars ) {
-        my @values = split "\0", $value;
-        $vars{$key} = @values <= 1 ? $values[0] : \@values;
+    for my $param ( $c->cgi->param ) { 
+        for my $value (  $c->cgi->param($param) ) {
+            push ( @params, $param, $value );
+        }
     }
-    $c->req->parameters( {%vars} );
+ 
+    $c->req->_assign_values( $c->req->parameters, \@params );
 }
 
 =item $c->prepare_path
@@ -139,7 +162,7 @@ sub prepare_path {
     my $base;
     {
         my $scheme = $ENV{HTTPS} ? 'https' : 'http';
-        my $host   = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
+        my $host   = $ENV{HTTP_HOST}   || $ENV{SERVER_NAME};
         my $port   = $ENV{SERVER_PORT} || 80;
         my $path   = $ENV{SCRIPT_NAME} || '/';
 
@@ -154,7 +177,7 @@ sub prepare_path {
 
     my $path = $ENV{PATH_INFO} || '/';
     $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-    $path =~  s/^\///;
+    $path =~ s/^\///;
 
     $c->req->base($base);
     $c->req->path($path);
@@ -164,7 +187,11 @@ sub prepare_path {
 
 =cut
 
-sub prepare_request { shift->cgi( CGI::Simple->new ) }
+sub prepare_request { 
+    my ( $c, $cgi ) = @_;
+    $c->cgi( $cgi || CGI->new );
+    $c->cgi->_reset_globals;
+}
 
 =item $c->prepare_uploads
 
@@ -172,14 +199,37 @@ sub prepare_request { shift->cgi( CGI::Simple->new ) }
 
 sub prepare_uploads {
     my $c = shift;
-    for my $name ( $c->cgi->upload ) {
-        next unless defined $name;
-        $c->req->uploads->{$name} = {
-            fh   => $c->cgi->upload($name),
-            size => $c->cgi->upload_info( $name, 'size' ),
-            type => $c->cgi->upload_info( $name, 'mime' )
-        };
+
+    my @uploads;
+    
+    for my $param ( $c->cgi->param ) {
+    
+        my @values = $c->cgi->param($param);
+
+        next unless ref( $values[0] );
+
+        for my $fh (@values) {
+
+            next unless my $size = ( stat $fh )[7];
+
+            my $info        = $c->cgi->uploadInfo($fh);
+            my $tempname    = $c->cgi->tmpFileName($fh);
+            my $type        = $info->{'Content-Type'};
+            my $disposition = $info->{'Content-Disposition'};
+            my $filename    = ( $disposition =~ / filename="([^;]*)"/ )[0];
+
+            my $upload = Catalyst::Request::Upload->new(
+                filename => $filename,
+                size     => $size,
+                tempname => $tempname,
+                type     => $type
+            );
+            
+            push( @uploads, $param, $upload );
+        }
     }
+    
+    $c->req->_assign_values( $c->req->uploads, \@uploads );
 }
 
 =item $c->run