From: John Napiorkowski Date: Mon, 2 Mar 2015 16:43:44 +0000 (-0600) Subject: Merge branch 'master' into australorp X-Git-Tag: 5.90089_002~51 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=772bd9deac85d462d77bfe2cbbe73f3de1688ebf;hp=d91504e32dc14e87f6650b1835f1287cac40fe7e Merge branch 'master' into australorp Conflicts: Changes lib/Catalyst.pm lib/Catalyst/Runtime.pm --- diff --git a/.travis.yml b/.travis.yml index a239757..d8b448a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,5 @@ language: perl +sudo: false perl: - "5.20" - "5.18" diff --git a/Changes b/Changes index 6b8e5f4..8fd50ce 100644 --- a/Changes +++ b/Changes @@ -2,7 +2,41 @@ 5.90089_001 - TBA -5.90080 - 2014-01-09 +5.90084 - 2015-02-23 + - Small change to the way body parameters are created in order to prevent + trying to create parameters twice. + - Use new HTTP::Body and code updates to fix issue when POSTed params have + non UTF-8 charset encodings or otherwise complex upload parts that are not + file uploads. In these cases when Catalyst can't determine what the value of + a form upload is, will return an instance of Catalyst::Request::PartData with + all the information need to figure it out. Documentation about this corner + case. For RT https://rt.cpan.org/Ticket/Display.html?id=101556 + - Two new application configuration parameters 'skip_body_param_unicode_decoding' + and 'skip_complex_post_part_handling' to assist you with any backward + compatibility issues with all the new UTF8 work in the most recent stable + Catalyst. You may use these settings to TEMPORARILY disable certain new + features while you are seeking a long term fix. + +5.90083 - 2015-02-16 + - Fixed typo in support for OPTIONS method matching (andre++) + - Stop using $env->{'plack.request.query'} as a query parsing optimization + since 1) it doesn't belong to us and 2) there's subtle differences in the + way plack parses parameters and catalyst does. This fixes a bug when you + are using middleware that uses Plack::Request to do its thing. This change + might have subtle impact on query parsing. Please test this change! + +5.90082 - 2015-01-10 + - Fixed a regression created in $response->from_psgi_response and test case + to prevent it happening again. + +5.90081 - 2015-01-10 + - created class attribute 'finalized_default_middleware' which determines + if the default middleware has been added to the stack yet or not. This + removes a horrible hack that polluted the configuration hash. Added + test case to prevent regressions. + +5.90080 - 2015-01-09 +>>>>>>> master - Minor documentation corrections - Make the '79 development series stable diff --git a/Makefile.PL b/Makefile.PL index f862960..a0aeb41 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -42,7 +42,7 @@ requires 'Data::Dump'; requires 'Data::OptList'; requires 'HTML::Entities'; requires 'HTML::HeadParser'; -requires 'HTTP::Body' => '1.06'; # ->cleanup(1) +requires 'HTTP::Body' => '1.22'; requires 'HTTP::Headers' => '1.64'; requires 'HTTP::Request' => '5.814'; requires 'HTTP::Response' => '5.813'; @@ -84,7 +84,7 @@ requires "Plack::Middleware::ContentLength"; requires "Plack::Middleware::Head"; requires "Plack::Middleware::HTTPExceptions"; requires "Plack::Middleware::FixMissingBodyInRedirect" => '0.09'; -requires "Plack::Middleware::MethodOverride"; +requires "Plack::Middleware::MethodOverride" => '0.12'; requires "Plack::Middleware::RemoveRedundantBody" => '0.03'; test_requires 'Test::Fatal'; diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index ceb238e..0d8a817 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -120,7 +120,7 @@ __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class engine_loader context_class request_class response_class stats_class setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware - _data_handlers _encoding _encode_check/; + _data_handlers _encoding _encode_check finalized_default_middleware/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->request_class('Catalyst::Request'); @@ -3233,6 +3233,7 @@ sub _handle_unicode_decoding { sub _handle_param_unicode_decoding { my ( $self, $value ) = @_; return unless defined $value; # not in love with just ignoring undefs - jnap + return $value if blessed($value); #don't decode when the value is an object. my $enc = $self->encoding; return try { @@ -3533,8 +3534,8 @@ sub setup_middleware { @middleware_definitions = reverse(@_); } else { @middleware_definitions = reverse(@{$class->config->{'psgi_middleware'}||[]}) - unless $class->config->{__configured_from_psgi_middleware}; - $class->config->{__configured_from_psgi_middleware} = 1; # Only do this once, just in case some people call setup over and over... + unless $class->finalized_default_middleware; + $class->finalized_default_middleware(1); # Only do this once, just in case some people call setup over and over... } my @middleware = (); @@ -3882,6 +3883,27 @@ backwardly compatible). =item * +C + +When creating body parameters from a POST, if we run into a multpart POST +that does not contain uploads, but instead contains inlined complex data +(very uncommon) we cannot reliably convert that into field => value pairs. So +instead we create an instance of L. If this causes +issue for you, you can disable this by setting C +to true (default is false). + +=item * + +C + +Generally we decode incoming POST params based on your declared encoding (the +default for this is to decode UTF-8). If this is causing you trouble and you +do not wish to turn all encoding support off (with the C configuration +parameter) you may disable this step atomically by setting this configuration +parameter to true. + +=item * + C - See L. =item * @@ -4316,6 +4338,8 @@ acme: Leon Brocard abraxxa: Alexander Hartmaier +andrewalker: André Walker + Andrew Bramble Andrew Ford EA.Ford@ford-mason.co.ukE diff --git a/lib/Catalyst/ActionRole/HTTPMethods.pm b/lib/Catalyst/ActionRole/HTTPMethods.pm index 8b9eef8..a67d629 100644 --- a/lib/Catalyst/ActionRole/HTTPMethods.pm +++ b/lib/Catalyst/ActionRole/HTTPMethods.pm @@ -47,13 +47,13 @@ Catalyst::ActionRole::HTTPMethods - Match on HTTP Methods sub user_base : Chained('/') CaptureArg(0) { ... } - sub get_user : Chained('user_base') Args(1) GET { ... } - sub post_user : Chained('user_base') Args(1) POST { ... } - sub put_user : Chained('user_base') Args(1) PUT { ... } - sub delete_user : Chained('user_base') Args(1) DELETE { ... } - sub head_user : Chained('user_base') Args(1) HEAD { ... } - sub option_user : Chained('user_base') Args(1) OPTION { ... } - sub option_user : Chained('user_base') Args(1) PATCH { ... } + sub get_user : Chained('user_base') Args(1) GET { ... } + sub post_user : Chained('user_base') Args(1) POST { ... } + sub put_user : Chained('user_base') Args(1) PUT { ... } + sub delete_user : Chained('user_base') Args(1) DELETE { ... } + sub head_user : Chained('user_base') Args(1) HEAD { ... } + sub options_user : Chained('user_base') Args(1) OPTIONS { ... } + sub patch_user : Chained('user_base') Args(1) PATCH { ... } sub post_and_put : Chained('user_base') POST PUT Args(1) { ... } diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index f2ccfa8..860339c 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -544,12 +544,12 @@ sub _parse_Does_attr { return Does => $self->_expand_role_shortname($value); } -sub _parse_GET_attr { Method => 'GET' } -sub _parse_POST_attr { Method => 'POST' } -sub _parse_PUT_attr { Method => 'PUT' } -sub _parse_DELETE_attr { Method => 'DELETE' } -sub _parse_OPTION_attr { Method => 'OPTION' } -sub _parse_HEAD_attr { Method => 'HEAD' } +sub _parse_GET_attr { Method => 'GET' } +sub _parse_POST_attr { Method => 'POST' } +sub _parse_PUT_attr { Method => 'PUT' } +sub _parse_DELETE_attr { Method => 'DELETE' } +sub _parse_OPTIONS_attr { Method => 'OPTIONS' } +sub _parse_HEAD_attr { Method => 'HEAD' } sub _expand_role_shortname { my ($self, @shortnames) = @_; diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index cd0d383..44c9c12 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -574,14 +574,6 @@ 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} : ''; @@ -595,41 +587,15 @@ sub prepare_query_parameters { return; } - my %query; - - # replace semi-colons - $query_string =~ s/;/&/g; - - my @params = grep { length $_ } split /&/, $query_string; - - for my $item ( @params ) { - - my ($param, $value) - = map { decode_utf8($self->unescape_uri($_)) } - split( /=/, $item, 2 ); - - unless(defined $param) { - $param = $self->unescape_uri($item); - $param = decode_utf8 $param; - } + $query_string =~ s/\A[&;]+//; - if ( exists $query{$param} ) { - if ( ref $query{$param} ) { - push @{ $query{$param} }, $value; - } - else { - $query{$param} = [ $query{$param}, $value ]; - } - } - else { - $query{$param} = $value; - } - } + my $p = Hash::MultiValue->new( + map { defined $_ ? decode_utf8($self->unescape_uri($_)) : $_ } + map { ( split /=/, $_, 2 )[0,1] } # slice forces two elements + split /[&;]+/, $query_string + ); - $c->request->query_parameters( - $c->request->_use_hash_multivalue ? - Hash::MultiValue->from_mixed(\%query) : - \%query); + $c->request->query_parameters( $c->request->_use_hash_multivalue ? $p : $p->mixed ); } =head2 $self->prepare_read($c) diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 0cfcbae..53f9337 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -12,6 +12,7 @@ use Hash::MultiValue; use Scalar::Util; use HTTP::Body; use Catalyst::Exception; +use Catalyst::Request::PartData; use Moose; use namespace::clean -except => 'meta'; @@ -179,6 +180,7 @@ has body_parameters => ( is => 'rw', required => 1, lazy => 1, + predicate => 'has_body_parameters', builder => 'prepare_body_parameters', ); @@ -318,14 +320,31 @@ sub prepare_body_chunk { sub prepare_body_parameters { my ( $self, $c ) = @_; - + return $self->body_parameters if $self->has_body_parameters; $self->prepare_body if ! $self->_has_body; unless($self->_body) { - return $self->_use_hash_multivalue ? Hash::MultiValue->new : {}; + my $return = $self->_use_hash_multivalue ? Hash::MultiValue->new : {}; + $self->body_parameters($return); + return $return; } - my $params = $self->_body->param; + my $params; + my %part_data = %{$self->_body->part_data}; + if(scalar %part_data && !$c->config->{skip_complex_post_part_handling}) { + foreach my $key (keys %part_data) { + my $proto_value = $part_data{$key}; + my ($val, @extra) = (ref($proto_value)||'') eq 'ARRAY' ? @$proto_value : ($proto_value); + + if(@extra) { + $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($_) } ($val,@extra)]; + } else { + $params->{$key} = Catalyst::Request::PartData->build_from_part_data($val); + } + } + } else { + $params = $self->_body->param; + } # If we have an encoding configured (like UTF-8) in general we expect a client # to POST with the encoding we fufilled the request in. Otherwise don't do any @@ -341,13 +360,16 @@ sub prepare_body_parameters { # # I need to see if $c is here since this also doubles as a builder for the object :( - if($c and $c->encoding) { + if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) { $params = $c->_handle_unicode_decoding($params); } - return $self->_use_hash_multivalue ? + my $return = $self->_use_hash_multivalue ? Hash::MultiValue->from_mixed($params) : $params; + + $self->body_parameters($return) unless $self->has_body_parameters; + return $return; } sub prepare_connection { @@ -544,6 +566,11 @@ be either a scalar or an arrayref containing scalars. These are the parameters from the POST part of the request, if any. +B If your POST is multipart, but contains non file upload parts (such +as an line part with an alternative encoding or content type) we cannot determine +the correct way to extra a meaningful value from the upload. In this case any +part like this will be represented as an instance of L. + =head2 $req->body_params Shortcut for body_parameters. diff --git a/lib/Catalyst/Request/PartData.pm b/lib/Catalyst/Request/PartData.pm new file mode 100644 index 0000000..7089373 --- /dev/null +++ b/lib/Catalyst/Request/PartData.pm @@ -0,0 +1,97 @@ +package Catalyst::Request::PartData; + +use Moose; +use HTTP::Headers; + +has [qw/raw_data name size/] => (is=>'ro', required=>1); + +has headers => ( + is=>'ro', + required=>1, + handles=>[qw/content_type content_encoding content_type_charset/]); + +sub build_from_part_data { + my ($class, $part_data) = @_; + return $part_data->{data} unless $class->part_data_has_complex_headers($part_data); + return $class->new( + raw_data => $part_data->{data}, + name => $part_data->{name}, + size => $part_data->{size}, + headers => HTTP::Headers->new(%{ $part_data->{headers} })); +} + +sub part_data_has_complex_headers { + my ($class, $part_data) = @_; + return scalar keys %{$part_data->{headers}} > 1 ? 1:0; +} + +__PACKAGE__->meta->make_immutable; + +=head1 NAME + +Catalyst::Request::Upload - handles file upload requests + +=head1 SYNOPSIS + + my $data_part = + +To specify where Catalyst should put the temporary files, set the 'uploadtmp' +option in the Catalyst config. If unset, Catalyst will use the system temp dir. + + __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' ); + +See also L. + +=head1 DESCRIPTION + +=head1 ATTRIBUTES + +This class defines the following immutable attributes + +=head2 raw_data + +The raw data as returned via L. + +=head2 name + +The part name that gets extracted from the content-disposition header. + +=head2 size + +The raw byte count (over http) of the data. This is not the same as the character +length + +=head2 headers + +An L object that represents the submitted headers of the POST. This +object will handle the following methods: + +=head3 content_type + +=head3 content_encoding + +=head3 content_type_charset + +These three methods are the same as methods described in L. + +=head1 METHODS + +=head2 build_from_part_data + +Factory method to build an object from part data returned by L + +=head2 part_data_has_complex_headers + +Returns true if there more than one header (indicates the part data is complex and +contains content type and encoding information.). + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 6df2dff..39bc4c0 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -135,8 +135,8 @@ is found. This also accepts an override encoding value that you can use to force a particular L layer. If neither are found the filehandle is set to :raw. -This is useful if you are pulling the file into code and inspecting bit and -maybe then sending those bits back as the response. (Please not this is not +This is useful if you are pulling the file into code and inspecting bits and +maybe then sending those bits back as the response. (Please note this is not a suitable filehandle to set in the body; use C if you are doing that). Please note that using this method sets the underlying filehandle IO layer diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm index 6143f25..74d59fe 100644 --- a/lib/Catalyst/Response.pm +++ b/lib/Catalyst/Response.pm @@ -148,7 +148,10 @@ sub from_psgi_response { my ($status, $headers, $body) = @$psgi_res; $self->status($status); $self->headers(HTTP::Headers->new(@$headers)); - $self->body(join('', @$body)); + # Can be arrayref or filehandle... + if(defined $body) { # probably paranoia + ref $body eq 'ARRAY' ? $self->body(join('', @$body)) : $self->body($body); + } } elsif(ref $psgi_res eq 'CODE') { $psgi_res->(sub { my $response = shift; @@ -156,7 +159,8 @@ sub from_psgi_response { $self->status($status); $self->headers(HTTP::Headers->new(@$headers)); if(defined $maybe_body) { - $self->body(join('', @$maybe_body)); + # Can be arrayref or filehandle... + ref $maybe_body eq 'ARRAY' ? $self->body(join('', @$maybe_body)) : $self->body($maybe_body); } else { return $self->write_fh; } diff --git a/lib/Catalyst/UTF8.pod b/lib/Catalyst/UTF8.pod index b32bc31..91aeaed 100644 --- a/lib/Catalyst/UTF8.pod +++ b/lib/Catalyst/UTF8.pod @@ -254,6 +254,43 @@ based tricks and workarounds for even more odd cases (just search the web for th a number of approaches. Hopefully as more compliant browsers become popular these edge cases will fade. +B It is possible for a form POST multipart response (normally a file upload) to contain +inline content with mixed content character sets and encoding. For example one might create +a POST like this: + + use utf8; + use HTTP::Request::Common; + + my $utf8 = 'test ♥'; + my $shiftjs = 'test テスト'; + my $req = POST '/root/echo_arg', + Content_Type => 'form-data', + Content => [ + arg0 => 'helloworld', + Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), + arg1 => [ + undef, '', + 'Content-Type' =>'text/plain; charset=UTF-8', + 'Content' => Encode::encode('UTF-8', $utf8)], + arg2 => [ + undef, '', + 'Content-Type' =>'text/plain; charset=SHIFT_JIS', + 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], + arg2 => [ + undef, '', + 'Content-Type' =>'text/plain; charset=SHIFT_JIS', + 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], + ]; + +In this case we've created a POST request but each part specifies its own content +character set (and setting a content encoding would also be possible). Generally one +would not run into this situation in a web browser context but for completeness sake +Catalyst will notice if a multipart POST contains parts with complex or extended +header information and in those cases it will not attempt to apply decoding to the +form values. Instead the part will be represented as an instance of an object +L which will contain all the header information needed +for you to perform custom parser of the data. + =head1 UTF8 Encoding in Body Response When does L encode your response body and what rules does it use to @@ -558,10 +595,17 @@ so you can disable this with the following configurations setting: Where C is your L subclass. +If you do not wish to disable all the Catalyst encoding features, you may disable specific +features via two additional configuration options: 'skip_body_param_unicode_decoding' +and 'skip_complex_post_part_handling'. The first will skip any attempt to decode POST +parameters in the creating of body parameters and the second will skip creation of instances +of L in the case that the multipart form upload contains parts +with a mix of content character sets. + If you believe you have discovered a bug in UTF8 body encoding, I strongly encourage you to report it (and not try to hack a workaround in your local code). We also recommend that you regard such a workaround as a temporary solution. It is ideal if L extension -authors can start to count on L doing the write thing for encoding +authors can start to count on L doing the write thing for encoding. =head1 Conclusion diff --git a/lib/Catalyst/Upgrading.pod b/lib/Catalyst/Upgrading.pod index e6a16ab..ebfa2a3 100644 --- a/lib/Catalyst/Upgrading.pod +++ b/lib/Catalyst/Upgrading.pod @@ -15,6 +15,12 @@ UTF8 is enabled going forwards and the expectation is that other ecosystem projects will assume this as well. At some point you application will not correctly function without this setting. +As of 5.90084 we've added two additional configuration flags for more selective +control over some encoding changes: 'skip_body_param_unicode_decoding' and +'skip_complex_post_part_handling'. You may use these to more selectively +disable new features while you are seeking a long term fix. Please review +CONFIGURATION in L. + For further information, please see L A number of projects in the wider ecosystem required minor updates to be able diff --git a/t/aggregate/live_component_controller_httpmethods.t b/t/aggregate/live_component_controller_httpmethods.t index 6507af1..9cc6e9f 100644 --- a/t/aggregate/live_component_controller_httpmethods.t +++ b/t/aggregate/live_component_controller_httpmethods.t @@ -1,13 +1,17 @@ use strict; use warnings; use Test::More; -use HTTP::Request::Common qw/GET POST DELETE PUT /; +use HTTP::Request::Common qw/GET POST DELETE PUT/; use FindBin; use lib "$FindBin::Bin/../lib"; use Catalyst::Test 'TestApp'; - + +sub OPTIONS { + HTTP::Request->new('OPTIONS', @_); +} + is(request(GET '/httpmethods/foo')->content, 'get'); is(request(POST '/httpmethods/foo')->content, 'post'); is(request(DELETE '/httpmethods/foo')->content, 'default'); @@ -34,4 +38,12 @@ is(request(GET '/httpmethods/check_default')->content, 'get3'); is(request(POST '/httpmethods/check_default')->content, 'post3'); is(request(PUT '/httpmethods/check_default')->content, 'chain_default'); +is(request(GET '/httpmethods/opt_typo')->content, 'typo'); +is(request(POST '/httpmethods/opt_typo')->content, 'typo'); +is(request(PUT '/httpmethods/opt_typo')->content, 'typo'); + +is(request(OPTIONS '/httpmethods/opt')->content, 'options'); +is(request(GET '/httpmethods/opt')->content, 'default'); +is(request(POST '/httpmethods/opt')->content, 'default'); + done_testing; diff --git a/t/author/spelling.t b/t/author/spelling.t index 9ebfaf5..f55ea40 100644 --- a/t/author/spelling.t +++ b/t/author/spelling.t @@ -24,6 +24,7 @@ add_stopwords(qw( chunked chunking codewise distingush equivilent plack Javascript gzipping ConfigLoader getline whitepaper matchable Andreas + André Ashton Axel Balint diff --git a/t/lib/TestApp/Controller/HTTPMethods.pm b/t/lib/TestApp/Controller/HTTPMethods.pm index e687372..2f7476d 100644 --- a/t/lib/TestApp/Controller/HTTPMethods.pm +++ b/t/lib/TestApp/Controller/HTTPMethods.pm @@ -30,6 +30,16 @@ sub any_method : Path('baz') { $ctx->response->body('any'); } +sub typo_option : Path('opt_typo') OPTION { + my ($self, $ctx) = @_; + $ctx->response->body('typo'); +} + +sub real_options : Path('opt') OPTIONS { + my ($self, $ctx) = @_; + $ctx->response->body('options'); +} + sub base :Chained('/') PathPrefix CaptureArgs(0) { } sub chained_get :Chained('base') Args(0) GET { diff --git a/t/plack-middleware.t b/t/plack-middleware.t index 4cc3e72..f6bf563 100644 --- a/t/plack-middleware.t +++ b/t/plack-middleware.t @@ -54,4 +54,15 @@ ok my($res, $c) = ctx_request('/'); ok $response->headers->{"x-runtime"}, "Got value for expected middleware"; } +{ + my $total_mw = scalar(TestMiddleware->registered_middlewares); + + TestMiddleware->setup_middleware; + TestMiddleware->setup_middleware; + + my $post_mw = scalar(TestMiddleware->registered_middlewares); + + is $total_mw, $post_mw, 'Calling ->setup_middleware does not re-add default middleware'; +} + done_testing; diff --git a/t/psgi_utils.t b/t/psgi_utils.t index 9c05559..eb69e9d 100644 --- a/t/psgi_utils.t +++ b/t/psgi_utils.t @@ -43,6 +43,18 @@ my $psgi_app = sub { $psgi_app->($env)); } + sub filehandle :Local { + my ($self, $c, $arg) = @_; + my $path = File::Spec->catfile('t', 'utf8.txt'); + open(my $fh, '<', $path) || die "trouble: $!"; + $c->res->from_psgi_response([200, ['Content-Type'=>'text/html'], $fh]); + } + + sub direct :Local { + my ($self, $c, $arg) = @_; + $c->res->from_psgi_response([200, ['Content-Type'=>'text/html'], ["hello","world"]]); + } + package MyApp::Controller::User; $INC{'MyApp/Controller/User.pm'} = __FILE__; @@ -383,4 +395,16 @@ use Catalyst::Test 'MyApp'; is_deeply $c->req->args, [111]; } +{ + use utf8; + use Encode; + my ($res, $c) = ctx_request('/docs/filehandle'); + is Encode::decode_utf8($res->content), "

This is stream_body_fh action ♥

\n"; +} + +{ + my ($res, $c) = ctx_request('/docs/direct'); + is $res->content, "helloworld"; +} + done_testing(); diff --git a/t/utf_incoming.t b/t/utf_incoming.t index 76eaa87..c144a44 100644 --- a/t/utf_incoming.t +++ b/t/utf_incoming.t @@ -4,9 +4,10 @@ use strict; use Test::More; use HTTP::Request::Common; use HTTP::Message::PSGI (); -use Encode 2.21 'decode_utf8', 'encode_utf8'; +use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode'; use File::Spec; use JSON::MaybeXS; +use Scalar::Util (); # Test cases for incoming utf8 @@ -187,6 +188,12 @@ use JSON::MaybeXS; $c->res->from_psgi_response( ref($c)->to_app->($env)); } + sub echo_arg :Local { + my ($self, $c) = @_; + $c->response->content_type('text/plain'); + $c->response->body($c->req->body_parameters->{arg}); + } + package MyApp; use Catalyst; @@ -375,7 +382,7 @@ use Catalyst::Test 'MyApp'; ok my $res = request $req; ## decode_json expect the binary utf8 string and does the decoded bit for us. - is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}; + is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly'; } { @@ -386,7 +393,7 @@ use Catalyst::Test 'MyApp'; is $enc->decode($res->content), "テスト", 'correct body'; is $res->content_length, 6, 'correct length'; # Bytes over the wire is length($enc->decode($res->content)), 3; - is $res->content_charset, 'SHIFT_JIS'; + is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected'; } { @@ -408,7 +415,7 @@ SKIP: { is $res->code, 200, 'OK'; is decode_utf8($content), "manual_1 ♥", 'correct body'; - is $res->content_charset, 'UTF-8'; + is $res->content_charset, 'UTF-8', 'zlib charset is set correctly'; } { @@ -424,7 +431,52 @@ SKIP: { is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is path-heart action ♥

', 'correct body'; is $res->content_length, 36, 'correct length'; - is $res->content_charset, 'UTF-8'; + is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset'; +} + +{ + my $utf8 = 'test ♥'; + my $shiftjs = 'test テスト'; + + ok my $req = POST '/root/echo_arg', + Content_Type => 'form-data', + Content => [ + arg0 => 'helloworld', + Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode... + Encode::encode('UTF-8','♥♥♥') => [ + undef, '', + 'Content-Type' =>'text/plain; charset=SHIFT_JIS', + 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], + arg1 => [ + undef, '', + 'Content-Type' =>'text/plain; charset=UTF-8', + 'Content' => Encode::encode('UTF-8', $utf8)], + arg2 => [ + undef, '', + 'Content-Type' =>'text/plain; charset=SHIFT_JIS', + 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], + arg2 => [ + undef, '', + 'Content-Type' =>'text/plain; charset=SHIFT_JIS', + 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], + ]; + + my ($res, $c) = ctx_request $req; + + is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value'; + is $c->req->body_parameters->{'♥'}, '♥♥'; + + ok Scalar::Util::blessed($c->req->body_parameters->{'arg1'}); + ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[0]); + ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[1]); + ok Scalar::Util::blessed($c->req->body_parameters->{'♥♥♥'}); + + # Since the form post is COMPLEX you are expected to decode it yourself. + is Encode::decode('UTF-8', $c->req->body_parameters->{'arg1'}->raw_data), $utf8, 'decoded utf8 param'; + is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[0]->raw_data), $shiftjs, 'decoded shiftjis param'; + is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[1]->raw_data), $shiftjs, 'decoded shiftjis param'; + is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'♥♥♥'}->raw_data), $shiftjs, 'decoded shiftjis param'; + } ## should we use binmode on filehandles to force the encoding...?