From: Christian Hansen <chansen@cpan.org>
Date: Sat, 16 Apr 2005 19:44:54 +0000 (+0000)
Subject: Fixed MP19 uploads. Added request/response body. Added support in all Engines for... 
X-Git-Tag: 5.7099_04~1498
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=06e1b6164a2c9d7b463f358b0d1934ef83a82845

Fixed MP19 uploads. Added request/response body. Added support in all Engines for body, also tested. Added test t/engine/request/body.t
---

diff --git a/MANIFEST b/MANIFEST
index 327b4e7..c88a09a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -42,6 +42,7 @@ t/component/controller/action/local.t
 t/component/controller/action/path.t
 t/component/controller/action/private.t
 t/component/controller/action/regexp.t
+t/engine/request/body.t
 t/engine/request/cookies.t
 t/engine/request/headers.t
 t/engine/request/parameters.t
diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index e4f22da..fb80e11 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -26,6 +26,9 @@ __PACKAGE__->mk_accessors(qw/request response state/);
 *req  = \&request;
 *res  = \&response;
 
+# For backwards compatibility
+*finalize_output = \&finalize_body;
+
 # For statistics
 our $COUNT = 1;
 our $START = time;
@@ -186,10 +189,18 @@ sub finalize {
     }
 
     my $status = $c->finalize_headers;
-    $c->finalize_output;
+    $c->finalize_body;
     return $status;
 }
 
+=item $c->finalize_body
+
+Finalize body.
+
+=cut
+
+sub finalize_body { }
+
 =item $c->finalize_cookies
 
 Finalize cookies.
@@ -324,14 +335,6 @@ Finalize headers.
 
 sub finalize_headers { }
 
-=item $c->finalize_output
-
-Finalize output.
-
-=cut
-
-sub finalize_output { }
-
 =item $c->handler( $class, $r )
 
 Handles the request.
@@ -420,19 +423,35 @@ sub prepare {
     $c->prepare_request($r);
     $c->prepare_path;
     $c->prepare_headers;
-    $c->prepare_input;
     $c->prepare_cookies;
     $c->prepare_connection;
+    $c->prepare_action;
 
     my $method   = $c->req->method   || '';
     my $path     = $c->req->path     || '';
     my $hostname = $c->req->hostname || '';
     my $address  = $c->req->address  || '';
+
     $c->log->debug(qq/"$method" request for "$path" from $hostname($address)/)
       if $c->debug;
 
-    $c->prepare_action;
-    $c->prepare_parameters;
+    if ( $c->request->method eq 'POST' and $c->request->content_length ) {
+
+        if ( $c->req->content_type eq 'application/x-www-form-urlencoded' ) {
+            $c->prepare_parameters;
+        }
+        elsif ( $c->req->content_type eq 'multipart/form-data' ) {
+            $c->prepare_parameters;
+            $c->prepare_uploads;
+        }
+        else {
+            $c->prepare_body;
+        }
+    }
+
+    if ( $c->request->method eq 'GET' ) {
+        $c->prepare_parameters;
+    }
 
     if ( $c->debug && keys %{ $c->req->params } ) {
         my $t = Text::ASCIITable->new;
@@ -446,7 +465,6 @@ sub prepare {
         $c->log->debug( 'Parameters are', $t->draw );
     }
 
-    $c->prepare_uploads;
     return $c;
 }
 
@@ -500,6 +518,14 @@ sub prepare_action {
       if ( $c->debug && @args );
 }
 
+=item $c->prepare_body
+
+Prepare message body.
+
+=cut
+
+sub prepare_body { }
+
 =item $c->prepare_connection
 
 Prepare connection.
@@ -536,14 +562,6 @@ Prepare parameters.
 
 =cut
 
-sub prepare_input { }
-
-=item $c->prepare_input
-
-Prepare message body.
-
-=cut
-
 sub prepare_parameters { }
 
 =item $c->prepare_path
diff --git a/lib/Catalyst/Engine/Apache.pm b/lib/Catalyst/Engine/Apache.pm
index a683631..7d11ea4 100644
--- a/lib/Catalyst/Engine/Apache.pm
+++ b/lib/Catalyst/Engine/Apache.pm
@@ -36,15 +36,36 @@ This class overloads some methods from C<Catalyst::Engine>.
 
 =over 4
 
-=item $c->finalize_output
+=item $c->finalize_body
 
 =cut
 
-sub finalize_output {
+sub finalize_body {
     my $c = shift;
     $c->apache->print( $c->response->output );
 }
 
+=item $c->prepare_body
+
+=cut
+
+sub prepare_body {
+    my $c = shift;
+
+    my $length = $c->request->content_length;
+    my ( $buffer, $content );
+
+    while ($length) {
+
+        $c->apache->read( $buffer, ( $length < 8192 ) ? $length : 8192 );
+
+        $length  -= length($buffer);
+        $content .= $buffer;
+    }
+    
+    $c->request->input($content);
+}
+
 =item $c->prepare_connection
 
 =cut
@@ -99,17 +120,6 @@ sub prepare_path {
     $c->request->base( $base->as_string );
 }
 
-=item $c->prepare_request($r)
-
-=cut
-
-sub prepare_request {
-    my ( $c, $r ) = @_;
-    $c->apache( $ENV{MOD_PERL_API_VERSION} == 2
-        ? Apache2::Request->new($r)
-        : Apache::Request->new($r) );
-}
-
 =item $c->run
 
 =cut
diff --git a/lib/Catalyst/Engine/Apache/MP13.pm b/lib/Catalyst/Engine/Apache/MP13.pm
index 5dd759a..9f7512e 100644
--- a/lib/Catalyst/Engine/Apache/MP13.pm
+++ b/lib/Catalyst/Engine/Apache/MP13.pm
@@ -20,7 +20,7 @@ See L<Catalyst>.
 
 =head1 DESCRIPTION
 
-This is the Catalyst engine specialized for Apache mod_perl version 1.
+This is the Catalyst engine specialized for Apache mod_perl version 1.3x.
 
 =head1 OVERLOADED METHODS
 
@@ -86,6 +86,15 @@ sub prepare_uploads {
     $c->req->_assign_values( $c->req->uploads, \@uploads );
 }
 
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache( Apache::Request->new($r) );
+}
+
 =back
 
 =head1 SEE ALSO
diff --git a/lib/Catalyst/Engine/Apache/MP19.pm b/lib/Catalyst/Engine/Apache/MP19.pm
index c068100..a14718a 100644
--- a/lib/Catalyst/Engine/Apache/MP19.pm
+++ b/lib/Catalyst/Engine/Apache/MP19.pm
@@ -27,7 +27,7 @@ See L<Catalyst>.
 
 =head1 DESCRIPTION
 
-This is the Catalyst engine specialized for Apache mod_perl version 2.
+This is the Catalyst engine specialized for Apache mod_perl version 1.9x.
 
 =head1 OVERLOADED METHODS
 
@@ -75,8 +75,8 @@ sub prepare_uploads {
     my $c = shift;
 
     my @uploads;
-
-    for my $field ( $c->apache->upload ) {
+    
+    for my $field ( $c->request->param ) {
 
         for my $upload ( $c->apache->upload($field) ) {
 
@@ -91,7 +91,16 @@ sub prepare_uploads {
         }
     }
 
-    $c->req->_assign_values( $c->req->uploads, \@uploads );
+    $c->request->_assign_values( $c->req->uploads, \@uploads );
+}
+
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache( Apache::Request->new($r) );
 }
 
 =back
diff --git a/lib/Catalyst/Engine/Apache/MP20.pm b/lib/Catalyst/Engine/Apache/MP20.pm
index 5fab658..ff54230 100644
--- a/lib/Catalyst/Engine/Apache/MP20.pm
+++ b/lib/Catalyst/Engine/Apache/MP20.pm
@@ -93,6 +93,15 @@ sub prepare_uploads {
     $c->req->_assign_values( $c->req->uploads, \@uploads );
 }
 
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache( Apache2::Request->new($r) );
+}
+
 =back
 
 =head1 SEE ALSO
diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm
index 28e9ac0..2840034 100644
--- a/lib/Catalyst/Engine/CGI.pm
+++ b/lib/Catalyst/Engine/CGI.pm
@@ -57,6 +57,17 @@ 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
@@ -70,15 +81,18 @@ sub finalize_headers {
     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->input( $c->cgi->param('POSTDATA') );
 }
 
 =item $c->prepare_connection
diff --git a/lib/Catalyst/Engine/Test.pm b/lib/Catalyst/Engine/Test.pm
index c783be1..88800fa 100644
--- a/lib/Catalyst/Engine/Test.pm
+++ b/lib/Catalyst/Engine/Test.pm
@@ -49,6 +49,15 @@ This class overloads some methods from C<Catalyst::Engine>.
 
 =over 4
 
+=item $c->finalize_body
+
+=cut
+
+sub finalize_body {
+    my $c = shift;
+    $c->http->response->content( $c->response->output );
+}
+
 =item $c->finalize_headers
 
 =cut
@@ -63,13 +72,13 @@ sub finalize_headers {
     }
 }
 
-=item $c->finalize_output
+=item $c->prepare_body
 
 =cut
 
-sub finalize_output {
+sub prepare_body {
     my $c = shift;
-    $c->http->response->content( $c->response->output );
+    $c->request->input( $c->http->request->content );
 }
 
 =item $c->prepare_connection
@@ -82,22 +91,6 @@ sub prepare_connection {
     $c->req->address( $c->http->address );
 }
 
-=item $c->prepare_input
-
-=cut
-
-sub prepare_input {
-    my $c = shift;
- 
-    return unless 
-            $c->request->content_length
-        and $c->request->content_type
-        and $c->request->content_type ne 'application/x-www-form-urlencoded'
-        and $c->request->content_type ne 'multipart/form-data';
-
-    $c->request->input( $c->http->request->content );
-}
-
 =item $c->prepare_headers
 
 =cut
diff --git a/lib/Catalyst/Manual/Internals.pod b/lib/Catalyst/Manual/Internals.pod
index 8e7a1bc..ae8e9f9 100644
--- a/lib/Catalyst/Manual/Internals.pod
+++ b/lib/Catalyst/Manual/Internals.pod
@@ -52,16 +52,17 @@ extend Catalyst.
       prepare
         prepare_request
         prepare_path
-        prepare_cookies
         prepare_headers
+        prepare_cookies
         prepare_connection
         prepare_action
+        prepare_body
         prepare_parameters
         prepare_uploads
       process
       finalize
         finalize_headers
-        finalize_output
+        finalize_body
 
 These steps are normally overloaded from engine classes, and may also be
 extended by plugins.  Extending means using multiple inheritance with L<NEXT>.
diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm
index 20cbdd5..04b7338 100644
--- a/lib/Catalyst/Request.pm
+++ b/lib/Catalyst/Request.pm
@@ -48,6 +48,7 @@ Catalyst::Request - Catalyst Request Class
     $req->args;
     $req->arguments;
     $req->base;
+    $req->body;
     $req->content_encoding;
     $req->content_length;
     $req->content_type;
@@ -107,6 +108,10 @@ Returns a reference to an array containing the arguments.
 
 Contains the url base. This will always have a trailing slash.
 
+=item $req->body
+
+Shortcut for $req->input.
+
 =item $req->content_encoding
 
 Shortcut to $req->headers->content_encoding
diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm
index 236f701..a84e3c8 100644
--- a/lib/Catalyst/Response.pm
+++ b/lib/Catalyst/Response.pm
@@ -17,6 +17,7 @@ Catalyst::Response - Catalyst Response Class
 =head1 SYNOPSIS
 
     $resp = $c->response;
+    $resp->body;
     $resp->content_encoding;
     $resp->content_length;
     $resp->content_type;
@@ -38,6 +39,10 @@ to response data.
 
 =over 4
 
+=item $resp->body
+
+Shortcut for $resp->output.
+
 =item $resp->content_encoding
 
 Shortcut to $resp->headers->content_encoding
diff --git a/t/engine/request/body.t b/t/engine/request/body.t
new file mode 100644
index 0000000..5ffc53d
--- /dev/null
+++ b/t/engine/request/body.t
@@ -0,0 +1,39 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More tests => 10;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+{
+    my $creq;
+
+    my $request = POST( 'http://localhost/dump/request/',
+        'Content-Type' => 'text/plain',
+        'Content'      => 'Hello Catalyst'
+    );
+
+    ok( my $response = request($request), 'Request' );
+    ok( $response->is_success, 'Response Successful 2xx' );
+    is( $response->content_type, 'text/plain', 'Response Content-Type' );
+    like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+    
+    {
+        no strict 'refs';
+        ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    }
+
+    isa_ok( $creq, 'Catalyst::Request' );
+    is( $creq->method, 'POST', 'Catalyst::Request method' );
+    is( $creq->content_type, 'text/plain', 'Catalyst::Request Content-Type' );
+    is( $creq->content_length, $request->content_length, 'Catalyst::Request Content-Length' );
+    is( $creq->input, $request->content, 'Catalyst::Request Content' );
+}
diff --git a/t/engine/request/uploads.t b/t/engine/request/uploads.t
index 4c0c5a2..5e82f84 100644
--- a/t/engine/request/uploads.t
+++ b/t/engine/request/uploads.t
@@ -29,7 +29,7 @@ use HTTP::Request::Common;
 
     ok( my $response = request($request), 'Request' );
     ok( $response->is_success, 'Response Successful 2xx' );
-    is( $response->content_type, 'text/plain', 'Response Content-Type' );
+    is( $response->content_type, 'text/plain', 'Response Content-Type' ); 
     like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
     
     {