X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=2aa6b1105c61dea9d246420fef1f2980932d1d8f;hp=a66847a360af43bea7b414a0a258f97a17f7a482;hb=d2c88741623b277f5420ae2fe75b8a830a4902ee;hpb=767480fd8b4151e350831a52dbc9c6265bf84485 diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index a66847a..2aa6b11 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -13,6 +13,8 @@ use URI::QueryParam; use Plack::Loader; use Catalyst::EngineLoader; use Encode (); +use Plack::Request::Upload; +use Hash::MultiValue; use utf8; use namespace::clean -except => 'meta'; @@ -20,25 +22,6 @@ use namespace::clean -except => 'meta'; # 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) = @_; - if(@args) { - warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI" - unless $WARN_ABOUT_ENV++; - return $self->_set_env(@args); - } - return $self->$orig; -}; - -# XXX - Only here for Engine::PSGI compat -sub prepare_connection { - my ($self, $ctx) = @_; - $ctx->request->prepare_connection; -} - =head1 NAME Catalyst::Engine - The Catalyst Engine @@ -54,30 +37,124 @@ See L. =head2 $self->finalize_body($c) -Finalize body. Prints the response output. +Finalize body. Prints the response output as blocking stream if it looks like +a filehandle, otherwise write it out all in one go. If there is no body in +the response, we assume you are handling it 'manually', such as for nonblocking +style or asynchronous streaming responses. You do this by calling L +several times (which sends HTTP headers if needed) or you close over +C<< $response->write_fh >>. + +See L and L for more. =cut sub finalize_body { my ( $self, $c ) = @_; - my $body = $c->response->body; - no warnings 'uninitialized'; - if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) { - my $got; - do { - $got = read $body, my ($buffer), $CHUNKSIZE; - $got = 0 unless $self->write( $c, $buffer ); - } while $got > 0; - - close $body; - } - else { - $self->write( $c, $body ); - } + my $res = $c->response; # We use this all over + + ## If we've asked for the write 'filehandle' that means the application is + ## doing something custom and is expected to close the response + return if $res->_has_write_fh; + + my $body = $res->body; # save some typing + if($res->_has_response_cb) { + ## we have not called the response callback yet, so we are safe to send + ## the whole body to PSGI + + my @headers; + $res->headers->scan(sub { push @headers, @_ }); + + # We need to figure out what kind of body we have and normalize it to something + # PSGI can deal with + if(defined $body) { + # Handle objects first + if(blessed($body)) { + if($body->can('getline')) { + # Body is an IO handle that meets the PSGI spec. Nothing to normalize + } elsif($body->can('read')) { + + # In the past, Catalyst only looked for ->read not ->getline. It is very possible + # that one might have an object that respected read but did not have getline. + # As a result, we need to handle this case for backcompat. + + # We will just do the old loop for now. In a future version of Catalyst this support + # will be removed and one will have to rewrite their custom object or use + # Plack::Middleware::AdaptFilehandleRead. In anycase support for this is officially + # deprecated and described as such as of 5.90060 + + my $got; + do { + $got = read $body, my ($buffer), $CHUNKSIZE; + $got = 0 unless $self->write($c, $buffer ); + } while $got > 0; + + close $body; + return; + } else { + # Looks like for backcompat reasons we need to be able to deal + # with stringyfiable objects. + $body = ["$body"]; + } + } elsif(ref $body) { + if( (ref($body) eq 'GLOB') or (ref($body) eq 'ARRAY')) { + # Again, PSGI can just accept this, no transform needed. We don't officially + # document the body as arrayref at this time (and there's not specific test + # cases. we support it because it simplifies some plack compatibility logic + # and we might make it official at some point. + } else { + $c->log->error("${\ref($body)} is not a valid value for Response->body"); + return; + } + } else { + # Body is defined and not an object or reference. We assume a simple value + # and wrap it in an array for PSGI + $body = [$body]; + } + } else { + # There's no body... + $body = []; + } - my $res = $c->response; - $res->_writer->close; - $res->_clear_writer; + $res->_response_cb->([ $res->status, \@headers, $body]); + $res->_clear_response_cb; + + } else { + ## Now, if there's no response callback anymore, that means someone has + ## called ->write in order to stream 'some stuff along the way'. I think + ## for backcompat we still need to handle a ->body. I guess I could see + ## someone calling ->write to presend some stuff, and then doing the rest + ## via ->body, like in a template. + + ## We'll just use the old, existing code for this (or most of it) + + if(my $body = $res->body) { + + if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) { + + ## In this case we have no choice and will fall back on the old + ## manual streaming stuff. Not optimal. This is deprecated as of 5.900560+ + + my $got; + do { + $got = read $body, my ($buffer), $CHUNKSIZE; + $got = 0 unless $self->write($c, $buffer ); + } while $got > 0; + + close $body; + } + else { + + # Case where body was set afgter calling ->write. We'd prefer not to + # support this, but I can see some use cases with the way most of the + # views work. + + $self->write($c, $body ); + } + } + + $res->_writer->close; + $res->_clear_writer; + } return; } @@ -113,8 +190,7 @@ sub finalize_cookies { ) ); if (!defined $cookie) { - $c->log->warn("undef passed in '$name' cookie value - not setting cookie") - if $c->debug; + $c->trace(1, "undef passed in '$name' cookie value - not setting cookie"); next; } @@ -167,6 +243,8 @@ sub finalize_error { } my ( $title, $error, $infos ); + ## For now we keep debug mode for turning on the default + ## debugging error screen - jnap. if ( $c->debug ) { # For pretty dumps @@ -181,7 +259,6 @@ sub finalize_error { $name = "

$name

"; # Don't show context in the dump - $c->req->_clear_context; $c->res->_clear_context; # Don't show body parser in the dump @@ -332,7 +409,7 @@ Allows engines to write headers to response sub finalize_headers { my ($self, $ctx) = @_; - $ctx->response->finalize_headers; + $ctx->finalize_headers unless $ctx->response->finalized_headers; return; } @@ -395,14 +472,17 @@ sub prepare_body_parameters { =head2 $self->prepare_parameters($c) -sets up parameters from query and post parameters. +Sets up parameters from query and post parameters. +If parameters have already been set up will clear +existing parameters and set up again. =cut sub prepare_parameters { my ( $self, $c ) = @_; - $c->request->parameters; + $c->request->_clear_parameters; + return $c->request->parameters; } =head2 $self->prepare_path($c) @@ -477,8 +557,16 @@ process the query string and extract query parameters. sub prepare_query_parameters { my ($self, $c) = @_; - my $env = $c->request->env; + + if(my $query_obj = $env->{'plack.request.query'}) { + $c->request->query_parameters( + $c->request->_use_hash_multivalue ? + $query_obj->clone : + $query_obj->as_hashref_mixed); + return; + } + my $query_string = exists $env->{QUERY_STRING} ? $env->{QUERY_STRING} : ''; @@ -486,7 +574,7 @@ sub prepare_query_parameters { # Check for keywords (no = signs) # (yes, index() is faster than a regex :)) if ( index( $query_string, '=' ) < 0 ) { - $c->request->query_keywords( $self->unescape_uri($query_string) ); + $c->request->query_keywords($self->unescape_uri($query_string)); return; } @@ -517,12 +605,16 @@ sub prepare_query_parameters { $query{$param} = $value; } } - $c->request->query_parameters( \%query ); + + $c->request->query_parameters( + $c->request->_use_hash_multivalue ? + Hash::MultiValue->from_mixed(\%query) : + \%query); } =head2 $self->prepare_read($c) -prepare to read from the engine. +Prepare to read by initializing the Content-Length from headers. =cut @@ -541,8 +633,8 @@ Populate the context object from the request object. sub prepare_request { my ($self, $ctx, %args) = @_; + $ctx->log->psgienv($args{env}) if $ctx->log->can('psgienv'); $ctx->request->_set_env($args{env}); - $self->_set_env($args{env}); # Nasty back compat! $ctx->response->_set_response_cb($args{response_cb}); } @@ -670,8 +762,7 @@ sub run { =head2 build_psgi_app ($app, @args) -Builds and returns a PSGI application closure, wrapping it in the reverse proxy -middleware if the using_frontend_proxy config setting is set. +Builds and returns a PSGI application closure. (Raw, not wrapped in middleware) =cut @@ -683,6 +774,7 @@ sub build_psgi_app { return sub { my ($respond) = @_; + confess("Did not get a response callback for writer, cannot continue") unless $respond; $app->handle_request(env => $env, response_cb => $respond); }; }; @@ -730,4 +822,6 @@ the same terms as Perl itself. =cut +__PACKAGE__->meta->make_immutable; + 1;