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=166a02d8c1031dd02ac801af730d14c589e01e26;hp=149d772a3ee46dfc4897ec6786f522a70e700288;hb=55f8e5163b1f5c502b92a9976350c611610c80e3;hpb=caf51bc1a69e4c6b16911a46b0ec9eb164a9e8ba diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index 149d772..166a02d 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -7,16 +7,12 @@ use CGI::Simple::Cookie; use Data::Dump qw/dump/; use Errno 'EWOULDBLOCK'; use HTML::Entities; -use HTTP::Body; use HTTP::Headers; -use URI::QueryParam; use Plack::Loader; use Catalyst::EngineLoader; -use Encode (); +use Encode 2.21 'decode_utf8'; use Plack::Request::Upload; use Hash::MultiValue; -use utf8; - use namespace::clean -except => 'meta'; # Amount of data to read from input on each pass @@ -75,6 +71,7 @@ sub finalize_body { ## 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 @@ -82,42 +79,55 @@ sub finalize_body { my @headers; $res->headers->scan(sub { push @headers, @_ }); - ## We need to figure out what kind of body we have... - my $body = $res->body; + # We need to figure out what kind of body we have and normalize it to something + # PSGI can deal with 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. + # 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 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; + # 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 { - # 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]; + # 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 { - $body = []; + # There's no body... + $body = []; } $res->_response_cb->([ $res->status, \@headers, $body]); @@ -133,11 +143,11 @@ sub finalize_body { ## 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. + ## manual streaming stuff. Not optimal. This is deprecated as of 5.900560+ my $got; do { @@ -148,6 +158,11 @@ sub finalize_body { 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 ); } } @@ -286,6 +301,7 @@ sub finalize_error { (pt) Por favor volte mais tarde (ru) Попробуйте еще раз позже (ua) Спробуйте ще раз пізніше +(it) Per favore riprova più tardi $name = ''; @@ -573,7 +589,9 @@ 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)); + my $keywords = $self->unescape_uri($query_string); + $keywords = decode_utf8 $keywords; + $c->request->query_keywords($keywords); return; } @@ -587,10 +605,13 @@ sub prepare_query_parameters { for my $item ( @params ) { my ($param, $value) - = map { $self->unescape_uri($_) } + = map { decode_utf8($self->unescape_uri($_)) } split( /=/, $item, 2 ); - $param = $self->unescape_uri($item) unless defined $param; + unless(defined $param) { + $param = $self->unescape_uri($item); + $param = decode_utf8 $param; + } if ( exists $query{$param} ) { if ( ref $query{$param} ) { @@ -648,20 +669,25 @@ sub prepare_uploads { my $request = $c->request; return unless $request->_body; + my $enc = $c->encoding; my $uploads = $request->_body->upload; my $parameters = $request->parameters; foreach my $name (keys %$uploads) { + $name = $c->_handle_unicode_decoding($name) if $enc; my $files = $uploads->{$name}; my @uploads; for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) { my $headers = HTTP::Headers->new( %{ $upload->{headers} } ); + my $filename = $upload->{filename}; + $filename = $c->_handle_unicode_decoding($filename) if $enc; + my $u = Catalyst::Request::Upload->new ( size => $upload->{size}, type => scalar $headers->content_type, headers => $headers, tempname => $upload->{tempname}, - filename => $upload->{filename}, + filename => $filename, ); push @uploads, $u; }