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=149d772a3ee46dfc4897ec6786f522a70e700288;hp=3b7c7fa83197b7471ca781e2da70b2a43bd61009;hb=0fb9468872e905cacecbff82b31170f7c7b1a081;hpb=717fc5c90d2cbbd6288bae9be82dbd8f6b917bab diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index 3b7c7fa..149d772 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'; @@ -57,43 +59,101 @@ See L. 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. - -By default we do not close the writer object in case we are in an event loop -and there is deferred activity. However if you have some sloppy code that is -closing over an unweakened context ($c) this could lead to the writer NEVER -being closed. In versions of Catalyst 5.90030 and older, we used to forcibly -close the writer in this method, but we no longer do that since it prevented us -from introducing proper asynchronous support in Catalyst core. If you have old -code that is leaking context but was otherwise working and you don't want to fix -your memory leaks (is really the best idea) you can force enable the old -behavior (and lose asynchronous support) by setting the global configuration key -C to true. See L -for more if you have this issue. +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; + + 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... + my $body = $res->body; + if(defined $body) { + if( + (blessed($body) && $body->can('getline')) + or ref($body) eq 'GLOB' + ) { + # Body is an IO handle that meets the PSGI spec + } elsif(blessed($body) && $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 but someone could write a proxy + # object to wrap getline and proxy read + my $got; + do { + $got = read $body, my ($buffer), $CHUNKSIZE; + $got = 0 unless $self->write($c, $buffer ); + } while $got > 0; + + # I really am guessing this case is pathological. I'd like to remove it + # but need to give people a bit of heads up + $c->log->warn('!!! Setting $response->body to an object that supports "read" but not "getline" is deprecated. !!!') + unless $self->{__FH_READ_DEPRECATION_NOTICE_qwvsretf43}++; + + close $body; + return; + } else { + # Looks like for backcompat reasons we need to be able to deal + # with stringyfiable objects. + $body = "$body" if blessed($body); # Assume there's some sort of overloading.. + $body = [$body]; + } + } else { + $body = []; + } - if($c->config->{aggressively_close_writer_on_finalize_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) { + no warnings 'uninitialized'; + 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. + + 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 ); + } + } + + $res->_writer->close; + $res->_clear_writer; } return; @@ -496,8 +556,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} : ''; @@ -505,7 +573,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; } @@ -536,7 +604,11 @@ 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) @@ -702,7 +774,7 @@ sub build_psgi_app { return sub { my ($respond) = @_; - confess("Did not get a response callback for writer, cannot continiue") unless $respond; + confess("Did not get a response callback for writer, cannot continue") unless $respond; $app->handle_request(env => $env, response_cb => $respond); }; };