merged conflicts
John Napiorkowski [Fri, 24 Jul 2015 19:39:37 +0000 (14:39 -0500)]
Changes
lib/Catalyst.pm
lib/Catalyst/Request.pm
lib/Catalyst/Request/PartData.pm
lib/Catalyst/Runtime.pm
t/utf_incoming.t

diff --git a/Changes b/Changes
index 708e433..822e1c8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,14 +1,18 @@
 # This file documents the revision history for Perl extension Catalyst.
 
-5.90099_001 - TBA
+5.90094 - 2015-07-24
+  - When there is a multipart POST request and the parts have extended
+    HTTP headers, try harder to decode and squeeze a meaningful value
+    out of it before giving up and crying.  Updated docs and tests to
+    reflect this change.
+  - Fixed issue where last_error actually returned the first error.  Took
+    the change to add a 'pop_errors' to give the inverse of shift_errors.
   - Merged Pull Requests:
     - https://github.com/perl-catalyst/catalyst-runtime/pull/95
     - https://github.com/perl-catalyst/catalyst-runtime/pull/96
     - https://github.com/perl-catalyst/catalyst-runtime/pull/97
     - https://github.com/perl-catalyst/catalyst-runtime/pull/98
     - https://github.com/perl-catalyst/catalyst-runtime/pull/106
-  - Fixed issue where last_error actually returned the first error.  Took
-    the change to add a 'pop_errors' to give the inverse of shift_errors.
 
 5.90093 - 2015-05-29
   - Fixed a bug where if you used $res->write and then $res->body, the
index d08e7ba..891b722 100644 (file)
@@ -180,7 +180,7 @@ sub composed_stats_class {
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90099_001';
+our $VERSION = '5.90094';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 sub import {
index 53f9337..3bcc6c2 100644 (file)
@@ -336,32 +336,35 @@ sub prepare_body_parameters {
         my $proto_value = $part_data{$key};
         my ($val, @extra) = (ref($proto_value)||'') eq 'ARRAY' ? @$proto_value : ($proto_value);
 
+        $key = $c->_handle_param_unicode_decoding($key)
+          if ($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding});
+
         if(@extra) {
-          $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($_) } ($val,@extra)];
+          $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($c, $_) } ($val,@extra)];
         } else {
-          $params->{$key} = Catalyst::Request::PartData->build_from_part_data($val);
+          $params->{$key} = Catalyst::Request::PartData->build_from_part_data($c, $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
-    # encoding (good change wide chars could be in HTML entity style llike the old
-    # days -JNAP
+      # 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
+      # encoding (good change wide chars could be in HTML entity style llike the old
+      # days -JNAP
 
-    # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure
-    # and do any needed decoding.
+      # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure
+      # and do any needed decoding.
 
-    # This only does something if the encoding is set via the encoding param.  Remember
-    # this is assuming the client is not bad and responds with what you provided.  In
-    # general you can just use utf8 and get away with it.
-    #
-    # I need to see if $c is here since this also doubles as a builder for the object :(
+      # This only does something if the encoding is set via the encoding param.  Remember
+      # this is assuming the client is not bad and responds with what you provided.  In
+      # general you can just use utf8 and get away with it.
+      #
+      # I need to see if $c is here since this also doubles as a builder for the object :(
 
-    if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
+      if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
         $params = $c->_handle_unicode_decoding($params);
+      }
     }
 
     my $return = $self->_use_hash_multivalue ?
@@ -567,10 +570,15 @@ 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
+as an line part with an alternative encoding or content type) we do our best to
+try and figure out how the value should be presented.  If there's a specified character
+set we will use that to decode rather than the default encoding set by the application.
+However if there are complex headers and 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>.
 
+Patches and review of this part of the code welcomed.
+
 =head2 $req->body_params
 
 Shortcut for body_parameters.
index 7089373..d6358f3 100644 (file)
@@ -2,6 +2,7 @@ package Catalyst::Request::PartData;
 
 use Moose;
 use HTTP::Headers;
+use Encode;
 
 has [qw/raw_data name size/] => (is=>'ro', required=>1);
 
@@ -11,7 +12,59 @@ has headers => (
   handles=>[qw/content_type content_encoding content_type_charset/]);
 
 sub build_from_part_data {
-  my ($class, $part_data) = @_;
+  my ($class, $c, $part_data) = @_;
+
+  # If the headers are complex, we need to work harder to figure out what to do
+  if(my $hdrs = $class->part_data_has_complex_headers($part_data)) {
+
+    # Ok so its one of two possibilities.  If I can inspect the headers and
+    # Figure out what to do, the I will return data.  Otherwise I will return
+    # a PartData object and expect you do deal with it.
+    # For now if I can find a charset in the content type I will just decode and
+    # assume I got it right (patches and bug reports welcomed).
+
+    # Any of these headers means I can't decode
+
+    if(
+        $hdrs->content_encoding
+    ) {
+      return $class->new(
+        raw_data => $part_data->{data},
+        name => $part_data->{name},
+        size => $part_data->{size},
+        headers => HTTP::Headers->new(%{ $part_data->{headers} }));
+    }
+
+    my ($ct, $charset) = $hdrs->content_type_charset;
+
+    if($ct) {
+      # Good news, we probably have data we can return.  If there is a charset
+      # then use that to decode otherwise use the default decoding.
+      if($charset) {
+        return  Encode::decode($charset, $part_data->{data})
+      } else {
+        if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
+          return $c->_handle_param_unicode_decoding($part_data->{data});
+        } else {
+          return $part_data->{data}
+        }
+      }
+    } else {
+      # I have no idea what to do with this now..
+      return $class->new(
+        raw_data => $part_data->{data},
+        name => $part_data->{name},
+        size => $part_data->{size},
+        headers => HTTP::Headers->new(%{ $part_data->{headers} }));
+    }
+  } else {
+    if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
+      return $c->_handle_param_unicode_decoding($part_data->{data});
+    } else {
+      return $part_data->{data}
+    }
+  }
+
   return $part_data->{data} unless $class->part_data_has_complex_headers($part_data);
   return $class->new(
     raw_data => $part_data->{data},
@@ -22,7 +75,16 @@ sub build_from_part_data {
 
 sub part_data_has_complex_headers {
   my ($class, $part_data) = @_;
-  return scalar keys %{$part_data->{headers}} > 1 ? 1:0;
+  my %h = %{$part_data->{headers}};
+  my $hdrs = HTTP::Headers->new(%h);
+
+  # Remove non threatening headers.
+  $hdrs->remove_header('Content-Length', 'Expires', 'Last-Modified', 'Content-Language');
+
+  # If we still have more than one (Content-Disposition) header we need to understand
+  # that and deal with it.
+
+  return $hdrs->header_field_names > 1 ? $hdrs :0;
 }
 
 __PACKAGE__->meta->make_immutable;
index 6307069..5872b5d 100644 (file)
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90099_001';
+our $VERSION = '5.90094';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 =head1 NAME
index ff61a6b..baa3f2a 100644 (file)
@@ -121,6 +121,7 @@ use Scalar::Util ();
 
   sub file_upload :POST  Consumes(Multipart) Local {
     my ($self, $c) = @_;
+
     Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
     Test::More::ok my $upload = $c->req->uploads->{file};
     Test::More::is $upload->charset, 'UTF-8';
@@ -481,17 +482,10 @@ SKIP: {
 
   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';
+  is $c->req->body_parameters->{'arg1'}, $utf8, 'decoded utf8 param';
+  is $c->req->body_parameters->{'arg2'}[0], $shiftjs, 'decoded shiftjs param';
+  is $c->req->body_parameters->{'arg2'}[1], $shiftjs, 'decoded shiftjs param';
+  is $c->req->body_parameters->{'♥♥♥'}, $shiftjs, 'decoded shiftjs param';
 
 }