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<\write>
-several times (which sends HTTP headers if needed) or you close over C<$response->write_fh>.
+style or asynchronous streaming responses. You do this by calling L</write>
+several times (which sends HTTP headers if needed) or you close over
+C<< $response->write_fh >>.
-See L<Catalyst::Response\write> and L<Catalyst::Response\write_fh> for more.
+See L<Catalyst::Response/write> and L<Catalyst::Response/write_fh> for more.
=cut
sub finalize_body {
my ( $self, $c ) = @_;
- return if $c->response->has_write_fh;
-
- 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 = [];
+ }
+
+ $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 );
+ }
+ }
- my $res = $c->response;
- $res->_writer->close;
- $res->_clear_writer;
+ $res->_writer->close;
+ $res->_clear_writer;
+ }
return;
}
# (yes, index() is faster than a regex :))
if ( index( $query_string, '=' ) < 0 ) {
$c->request->query_keywords($self->unescape_uri($query_string));
- $env->{'plack.request.query'} ||= Hash::MultiValue->new(
- map { (URI::Escape::uri_unescape($_), '') }
- split(/\+/, $query_string, -1));
-
return;
}
}
}
- $env->{'plack.request.query'} ||= Hash::MultiValue->from_mixed(\%query);
$c->request->query_parameters(
$c->request->_use_hash_multivalue ?
- $env->{'plack.request.query'}->clone :
+ Hash::MultiValue->from_mixed(\%query) :
\%query);
}
my $uploads = $request->_body->upload;
my $parameters = $request->parameters;
- my @plack_uploads;
foreach my $name (keys %$uploads) {
my $files = $uploads->{$name};
my @uploads;
filename => $upload->{filename},
);
push @uploads, $u;
-
- # Plack compatibility.
- my %copy = (%$upload, headers=>$headers);
- push @plack_uploads, $name, Plack::Request::Upload->new(%copy);
}
$request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
-
# support access to the filename as a normal param
my @filenames = map { $_->{filename} } @uploads;
# append, if there's already params with this name
$parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0];
}
}
-
- $self->env->{'plack.request.upload'} ||= Hash::MultiValue->new(@plack_uploads);
}
=head2 $self->write($c, $buffer)
projects / catagits/Catalyst-Runtime.git / blobdiff