Move all request state out of the engine into Request/Response.
Tomas Doran [Tue, 23 Aug 2011 16:20:18 +0000 (17:20 +0100)]
lib/Catalyst/Engine.pm
lib/Catalyst/Request.pm
lib/Catalyst/Response.pm
t/aggregate/live_engine_request_env.t
t/aggregate/live_engine_request_uri.t
t/aggregate/unit_core_engine-prepare_path.t
t/lib/TestApp/Controller/Dump.pm
t/lib/TestApp/View/Dump/Env.pm
t/lib/TestApp/View/Dump/Request.pm
t/lib/TestApp/View/Dump/Response.pm

index 2a5f5f7..f305ec3 100644 (file)
@@ -10,7 +10,6 @@ use HTML::Entities;
 use HTTP::Body;
 use HTTP::Headers;
 use URI::QueryParam;
-use Moose::Util::TypeConstraints;
 use Plack::Loader;
 use Catalyst::EngineLoader;
 use Encode ();
@@ -18,8 +17,11 @@ use utf8;
 
 use namespace::clean -except => 'meta';
 
-has env => (is => 'ro', writer => '_set_env', clearer => '_clear_env');
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
 
+# XXX - this is only here for compat, do not use!
+has env => ( is => 'rw', writer => '_set_env' );
 my $WARN_ABOUT_ENV = 0;
 around env => sub {
   my ($orig, $self, @args) = @_;
@@ -31,33 +33,6 @@ around env => sub {
   return $self->$orig;
 };
 
-# input position and length
-has read_length => (is => 'rw');
-has read_position => (is => 'rw');
-
-has _prepared_write => (is => 'rw');
-
-has _response_cb => (
-    is      => 'ro',
-    isa     => 'CodeRef',
-    writer  => '_set_response_cb',
-    clearer => '_clear_response_cb',
-    predicate => '_has_response_cb',
-);
-
-subtype 'Catalyst::Engine::Types::Writer',
-    as duck_type([qw(write close)]);
-
-has _writer => (
-    is      => 'ro',
-    isa     => 'Catalyst::Engine::Types::Writer',
-    writer  => '_set_writer',
-    clearer => '_clear_writer',
-);
-
-# Amount of data to read from input on each pass
-our $CHUNKSIZE = 64 * 1024;
-
 =head1 NAME
 
 Catalyst::Engine - The Catalyst Engine
@@ -94,9 +69,9 @@ sub finalize_body {
         $self->write( $c, $body );
     }
 
-    $self->_writer->close;
-    $self->_clear_writer;
-    $self->_clear_env;
+    my $res = $c->response;
+    $res->_writer->close;
+    $res->_clear_writer;
 
     return;
 }
@@ -358,13 +333,14 @@ sub finalize_headers {
     # sets response_cb. So take the lack of a response_cb as a sign that we
     # don't need to set the headers.
 
-    return unless $self->_has_response_cb;
+    return unless ($ctx->response->_has_response_cb);
 
     my @headers;
     $ctx->response->headers->scan(sub { push @headers, @_ });
 
-    $self->_set_writer($self->_response_cb->([ $ctx->response->status, \@headers ]));
-    $self->_clear_response_cb;
+    my $writer = $ctx->response->_response_cb->([ $ctx->response->status, \@headers ]);
+    $ctx->response->_set_writer($writer);
+    $ctx->response->_clear_response_cb;
 
     return;
 }
@@ -405,8 +381,8 @@ sub prepare_body {
     my ( $self, $c ) = @_;
 
     my $appclass = ref($c) || $c;
-    if ( my $length = $self->read_length ) {
-        my $request = $c->request;
+    my $request = $c->request;
+    if ( my $length = $request->_read_length ) {
         unless ( $request->_body ) {
             my $type = $request->header('Content-Type');
             $request->_body(HTTP::Body->new( $type, $length ));
@@ -421,7 +397,7 @@ sub prepare_body {
         }
 
         # paranoia against wrong Content-Length header
-        my $remaining = $length - $self->read_position;
+        my $remaining = $length - $c->request->_read_position;
         if ( $remaining > 0 ) {
             $self->finalize_read($c);
             Catalyst::Exception->throw(
@@ -469,8 +445,8 @@ Abstract method implemented in engines.
 sub prepare_connection {
     my ($self, $ctx) = @_;
 
-    my $env = $self->env;
     my $request = $ctx->request;
+    my $env = $ctx->request->env;
 
     $request->address( $env->{REMOTE_ADDR} );
     $request->hostname( $env->{REMOTE_HOST} )
@@ -504,7 +480,7 @@ sub prepare_cookies {
 sub prepare_headers {
     my ($self, $ctx) = @_;
 
-    my $env = $self->env;
+    my $env = $ctx->request->env;
     my $headers = $ctx->request->headers;
 
     for my $header (keys %{ $env }) {
@@ -554,7 +530,7 @@ abstract method, implemented by engines.
 sub prepare_path {
     my ($self, $ctx) = @_;
 
-    my $env = $self->env;
+    my $env = $ctx->request->env;
 
     my $scheme    = $ctx->request->secure ? 'https' : 'http';
     my $host      = $env->{HTTP_HOST} || $env->{SERVER_NAME};
@@ -618,8 +594,9 @@ process the query string and extract query parameters.
 sub prepare_query_parameters {
     my ($self, $c) = @_;
 
-    my $query_string = exists $self->env->{QUERY_STRING}
-        ? $self->env->{QUERY_STRING}
+    my $env = $c->request->env;
+    my $query_string = exists $env->{QUERY_STRING}
+        ? $env->{QUERY_STRING}
         : '';
 
     # Check for keywords (no = signs)
@@ -669,11 +646,8 @@ prepare to read from the engine.
 sub prepare_read {
     my ( $self, $c ) = @_;
 
-    # Initialize the read position
-    $self->read_position(0);
-
     # Initialize the amount of data we think we need to read
-    $self->read_length( $c->request->header('Content-Length') || 0 );
+    $c->request->_read_length;
 }
 
 =head2 $self->prepare_request(@arguments)
@@ -684,7 +658,9 @@ Populate the context object from the request object.
 
 sub prepare_request {
     my ($self, $ctx, %args) = @_;
-    $self->_set_env($args{env});
+    $ctx->request->_set_env($args{env});
+    $self->_set_env($args{env}); # Nasty back compat!
+    $ctx->response->_set_response_cb($args{response_cb});
 }
 
 =head2 $self->prepare_uploads($c)
@@ -752,7 +728,8 @@ Maintains the read_length and read_position counters as data is read.
 sub read {
     my ( $self, $c, $maxlength ) = @_;
 
-    my $remaining = $self->read_length - $self->read_position;
+    my $request = $c->request;
+    my $remaining = $request->_read_length - $request->_read_position;
     $maxlength ||= $CHUNKSIZE;
 
     # Are we done reading?
@@ -769,7 +746,8 @@ sub read {
             $self->finalize_read;
             return;
         }
-        $self->read_position( $self->read_position + $rc );
+        my $request = $c->request;
+        $request->_read_position( $request->_read_position + $rc );
         return $buffer;
     }
     else {
@@ -788,7 +766,7 @@ there is no more data to be read.
 
 sub read_chunk {
     my ($self, $ctx) = (shift, shift);
-    return $self->env->{'psgi.input'}->read(@_);
+    return $ctx->request->env->{'psgi.input'}->read(@_);
 }
 
 =head2 $self->read_length
@@ -852,8 +830,7 @@ sub build_psgi_app {
 
         return sub {
             my ($respond) = @_;
-            $self->_set_response_cb($respond);
-            $app->handle_request(env => $env);
+            $app->handle_request(env => $env, response_cb => $respond);
         };
     };
 }
@@ -867,15 +844,16 @@ Writes the buffer to the client.
 sub write {
     my ( $self, $c, $buffer ) = @_;
 
-    unless ( $self->_prepared_write ) {
+    my $response = $c->response;
+    unless ( $response->_prepared_write ) {
         $self->prepare_write($c);
-        $self->_prepared_write(1);
+        $response->_set_prepared_write(1);
     }
 
     $buffer = q[] unless defined $buffer;
 
     my $len = length($buffer);
-    $self->_writer->write($buffer);
+    $c->res->_writer->write($buffer);
 
     return $len;
 }
index 6d14c5b..aa2c03d 100644 (file)
@@ -14,6 +14,17 @@ use namespace::clean -except => 'meta';
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
+has env => (is => 'ro', writer => '_set_env');
+
+has _read_position => ( is => 'rw', default => 0 );
+has _read_length => ( is => 'ro',
+    default => sub {
+        my $self = shift;
+        $self->header('Content-Length') || 0;
+    },
+    lazy => 1,
+);
+
 has action => (is => 'rw');
 has address => (is => 'rw');
 has arguments => (is => 'rw', default => sub { [] });
index 1e1e4bf..0798471 100644 (file)
@@ -2,9 +2,34 @@ package Catalyst::Response;
 
 use Moose;
 use HTTP::Headers;
+use Moose::Util::TypeConstraints;
+use namespace::autoclean;
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
+has _prepared_write => (is => 'ro', writer => '_set_prepared_write');
+
+has _response_cb => (
+    is      => 'ro',
+    isa     => 'CodeRef',
+    writer  => '_set_response_cb',
+    clearer => '_clear_response_cb',
+    predicate => '_has_response_cb',
+);
+
+subtype 'Catalyst::Engine::Types::Writer',
+    as duck_type([qw(write close)]);
+
+has _writer => (
+    is      => 'ro',
+    isa     => 'Catalyst::Engine::Types::Writer',
+    writer  => '_set_writer',
+    clearer => '_clear_writer',
+    predicate => '_has_writer',
+);
+
+sub DEMOLISH { $_[0]->_writer->close if $_[0]->_has_writer }
+
 has cookies   => (is => 'rw', default => sub { {} });
 has body      => (is => 'rw', default => undef);
 sub has_body { defined($_[0]->body) }
@@ -31,8 +56,6 @@ sub output { shift->body(@_) }
 
 sub code   { shift->status(@_) }
 
-no Moose;
-
 =head1 NAME
 
 Catalyst::Response - stores output responding to the current client request
@@ -187,15 +210,20 @@ $res->code is an alias for this, to match HTTP::Response->code.
 
 Writes $data to the output stream.
 
-=head2 meta
-
-Provided by Moose
-
 =head2 $res->print( @data )
 
 Prints @data to the output stream, separated by $,.  This lets you pass
 the response object to functions that want to write to an L<IO::Handle>.
 
+=head2 DEMOLISH
+
+Ensures that the response is flushed and closed at the end of the
+request.
+
+=head2 meta
+
+Provided by Moose
+
 =cut
 
 sub print {
index 59a2219..6d3e3e9 100644 (file)
@@ -16,15 +16,15 @@ BEGIN {
     $EXPECTED_ENV_VAL = "Test env value " . rand(100000);
 }
 
-use Test::More tests => 7;
+use Test::More;
 use Catalyst::Test 'TestApp';
 
 use Catalyst::Request;
 use HTTP::Headers;
 use HTTP::Request::Common;
 
-{
-    my $response = request("http://localhost/dump/env", {
+foreach my $path (qw/ env env_on_engine /) {
+    my $response = request("http://localhost/dump/${path}", {
         extra_env => { $EXPECTED_ENV_VAR => $EXPECTED_ENV_VAL },
     });
 
@@ -35,7 +35,7 @@ use HTTP::Request::Common;
     my $env;
     ok( eval '$env = ' . $response->content, 'Unserialize Catalyst::Request' );
     is ref($env), 'HASH';
-    ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var';
+    ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var for ' . $path;
 
     SKIP:
     {
@@ -43,7 +43,9 @@ use HTTP::Request::Common;
             skip 'Using remote server', 1;
         }
         is $env->{$EXPECTED_ENV_VAR}, $EXPECTED_ENV_VAL,
-            'Value we set as expected';
+            'Value we set as expected for ' . $path;
     }
 }
 
+done_testing;
+
index b26e156..5618e7c 100644 (file)
@@ -14,7 +14,8 @@ my $creq;
 {
     ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' );
     ok( $response->is_success, 'Response Successful 2xx' );
-    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' )
+        or diag("Exception '$@', content " . $response->content);
     like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );
 }
 
index d315396..cfeaddf 100644 (file)
@@ -126,13 +126,12 @@ sub get_req {
         PATH_INFO => '/',
     );
 
-    my $engine = Catalyst::Engine->new(
-        env => { %template, @_ },
-    );
+    my $engine = Catalyst::Engine->new();
     my $i = TestApp->new;
     $i->setup_finished(0);
     $i->config(use_request_uri_for_path => $use_request_uri_for_path);
     $i->setup_finished(1);
+    $engine->prepare_request($i, env => { %template, @_ }, response_cb => sub {});
     $engine->prepare_path($i);
     return $i->req;
 }
index 69431b3..84ebe8d 100644 (file)
@@ -10,6 +10,13 @@ sub default : Action {
 
 sub env : Action Relative {
     my ( $self, $c ) = @_;
+    $c->stash(env => $c->req->env);
+    $c->forward('TestApp::View::Dump::Env');
+}
+
+sub env_on_engine : Action Relative {
+    my ( $self, $c ) = @_;
+    $c->stash(env => $c->engine->env);
     $c->forward('TestApp::View::Dump::Env');
 }
 
index d713b0e..08d938c 100644 (file)
@@ -5,7 +5,7 @@ use base qw[TestApp::View::Dump];
 
 sub process {
     my ( $self, $c ) = @_;
-    my $env = $c->engine->env;
+    my $env = $c->stash->{env};
     return $self->SUPER::process($c, {
         map { ($_ => $env->{$_}) }
         grep { $_ ne 'psgi.input' }
index 5655b3f..97926ec 100644 (file)
@@ -5,7 +5,9 @@ use base qw[TestApp::View::Dump];
 
 sub process {
     my ( $self, $c ) = @_;
-    return $self->SUPER::process( $c, $c->request );
+    my $r = $c->request;
+    local $r->{env};
+    return $self->SUPER::process( $c, $r );
 }
 
 1;
index 010d01c..3f9b361 100644 (file)
@@ -5,7 +5,10 @@ use base qw[TestApp::View::Dump];
 
 sub process {
     my ( $self, $c ) = @_;
-    return $self->SUPER::process( $c, $c->response );
+    my $r = $c->response;
+    local $r->{_writer};
+    local $r->{_reponse_cb};
+    return $self->SUPER::process( $c, $r );
 }
 
 1;