Merge branch 'master' into australorp
John Napiorkowski [Mon, 2 Mar 2015 16:43:44 +0000 (10:43 -0600)]
Conflicts:
Changes
lib/Catalyst.pm
lib/Catalyst/Runtime.pm

19 files changed:
.travis.yml
Changes
Makefile.PL
lib/Catalyst.pm
lib/Catalyst/ActionRole/HTTPMethods.pm
lib/Catalyst/Controller.pm
lib/Catalyst/Engine.pm
lib/Catalyst/Request.pm
lib/Catalyst/Request/PartData.pm [new file with mode: 0644]
lib/Catalyst/Request/Upload.pm
lib/Catalyst/Response.pm
lib/Catalyst/UTF8.pod
lib/Catalyst/Upgrading.pod
t/aggregate/live_component_controller_httpmethods.t
t/author/spelling.t
t/lib/TestApp/Controller/HTTPMethods.pm
t/plack-middleware.t
t/psgi_utils.t
t/utf_incoming.t

index a239757..d8b448a 100644 (file)
@@ -1,4 +1,5 @@
 language: perl
+sudo: false
 perl:
    - "5.20"
    - "5.18"
diff --git a/Changes b/Changes
index 6b8e5f4..8fd50ce 100644 (file)
--- 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
 
index f862960..a0aeb41 100644 (file)
@@ -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';
index ceb238e..0d8a817 100644 (file)
@@ -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<skip_complex_post_part_handling>
+
+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<Catalyst::Request::PartData>.  If this causes
+issue for you, you can disable this by setting C<skip_complex_post_part_handling>
+to true (default is false).  
+
+=item *
+
+C<skip_body_param_unicode_decoding>
+
+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<encoding> configuration
+parameter) you may disable this step atomically by setting this configuration
+parameter to true.
+
+=item *
+
 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
 
 =item *
@@ -4316,6 +4338,8 @@ acme: Leon Brocard <leon@astray.com>
 
 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
 
+andrewalker: André Walker <andre@cpan.org>
+
 Andrew Bramble
 
 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
index 8b9eef8..a67d629 100644 (file)
@@ -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) { ... }
index f2ccfa8..860339c 100644 (file)
@@ -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) = @_;
index cd0d383..44c9c12 100644 (file)
@@ -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)
index 0cfcbae..53f9337 100644 (file)
@@ -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<NOTE> 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<Catalyst::Request::PartData>.
+
 =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 (file)
index 0000000..7089373
--- /dev/null
@@ -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<Catalyst>.
+
+=head1 DESCRIPTION
+
+=head1 ATTRIBUTES
+
+This class defines the following immutable attributes
+
+=head2 raw_data
+
+The raw data as returned via L<HTTP::Body>.
+
+=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<HTTP::Headers> 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<HTTP::Headers>.
+
+=head1 METHODS
+
+=head2 build_from_part_data
+
+Factory method to build an object from part data returned by L<HTTP::Body>
+
+=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
index 6df2dff..39bc4c0 100644 (file)
@@ -135,8 +135,8 @@ is found. This also accepts an override encoding value that you can use to
 force a particular L<PerlIO> 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<fh> if you are doing that).
 
 Please note that using this method sets the underlying filehandle IO layer
index 6143f25..74d59fe 100644 (file)
@@ -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;
             }
index b32bc31..91aeaed 100644 (file)
@@ -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<NOTE>  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<Catalyst::Request::PartData> 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<Catalyst> 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<MyApp> is your L<Catalyst> 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<Catalyst::Request::PartData> 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<Catalyst> extension
-authors can start to count on L<Catalyst> doing the write thing for encoding
+authors can start to count on L<Catalyst> doing the write thing for encoding.
 
 =head1 Conclusion
 
index e6a16ab..ebfa2a3 100644 (file)
@@ -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<Catalyst>.
+
 For further information, please see L<Catalyst::UTF8>
 
 A number of projects in the wider ecosystem required minor updates to be able
index 6507af1..9cc6e9f 100644 (file)
@@ -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;
index 9ebfaf5..f55ea40 100644 (file)
@@ -24,6 +24,7 @@ add_stopwords(qw(
     chunked chunking codewise distingush equivilent plack Javascript gzipping
     ConfigLoader getline whitepaper matchable
     Andreas
+    André
     Ashton
     Axel
     Balint
index e687372..2f7476d 100644 (file)
@@ -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 {
index 4cc3e72..f6bf563 100644 (file)
@@ -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;
index 9c05559..eb69e9d 100644 (file)
@@ -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), "<p>This is stream_body_fh action ♥</p>\n";
+}
+
+{
+  my ($res, $c) = ctx_request('/docs/direct');
+  is $res->content, "helloworld";
+}
+
 done_testing();
index 76eaa87..c144a44 100644 (file)
@@ -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), '<p>This is path-heart action ♥</p>', '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...?