configurable decoding of query/body params in Web::Dispatch

diff --git a/Changes b/Changes
index 705b9c7..054c1ad 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - configurable query/body parameter decoding
+
 0.020 - 2012-08-03
   - re-dist for botched release
 

diff --git a/lib/Web/Dispatch/ParamParser.pm b/lib/Web/Dispatch/ParamParser.pm
index a00146e..764929c 100644 (file)
--- a/lib/Web/Dispatch/ParamParser.pm
+++ b/lib/Web/Dispatch/ParamParser.pm
@@ -2,16 +2,18 @@ package Web::Dispatch::ParamParser;
 
 use strict;
 use warnings FATAL => 'all';
+use Encode 2.21 ();
 
 sub UNPACKED_QUERY () { __PACKAGE__.'.unpacked_query' }
 sub UNPACKED_BODY () { __PACKAGE__.'.unpacked_body' }
 sub UNPACKED_BODY_OBJECT () { __PACKAGE__.'.unpacked_body_object' }
 sub UNPACKED_UPLOADS () { __PACKAGE__.'.unpacked_uploads' }
+sub PARAM_ENCODING () { __PACKAGE__.'.param_encoding' }
 sub ORIG_ENV () { 'Web::Dispatch.original_env' }
 
 sub get_unpacked_query_from {
   return ($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_QUERY} ||= do {
-    _unpack_params($_[0]->{QUERY_STRING})
+    _decode_params(_unpack_params($_[0]->{QUERY_STRING}), $_[0])
   };
 }
 
@@ -22,17 +24,18 @@ sub get_unpacked_body_from {
       {}
     } elsif (index($ct, 'application/x-www-form-urlencoded') >= 0) {
       $_[0]->{'psgi.input'}->read(my $buf, $_[0]->{CONTENT_LENGTH});
-      _unpack_params($buf);
+      _decode_params(_unpack_params($buf), $_[0]);
     } elsif (index($ct, 'multipart/form-data') >= 0) {
       my $p = get_unpacked_body_object_from($_[0])->param;
       # forcible arrayification (functional, $p does not belong to us,
       # do NOT replace this with a side-effect ridden "simpler" version)
-      +{
+      my $array_params = {
         map +(ref($p->{$_}) eq 'ARRAY'
                ? ($_ => $p->{$_})
                : ($_ => [ $p->{$_} ])
              ), keys %$p
       };
+      _decode_params($array_params, $_[0]);
     } else {
       {}
     }
@@ -85,6 +88,22 @@ sub get_unpacked_uploads_from {
   };
 }
 
+sub _decode_params {
+  my ($params, $env) = @_;
+  return $params if !(my $enc_name = $env->{+PARAM_ENCODING});
+
+  my $encoding = Encode::find_encoding($enc_name)
+    or die "Unknown encoding '$enc_name'";
+  my $CHECK = Encode::FB_CROAK | Encode::LEAVE_SRC;
+
+  my %p = map {
+    $encoding->decode($_, $CHECK) => [
+      map { $encoding->decode($_, $CHECK) } @{$params->{$_}}
+    ]
+  } keys %$params;
+  return \%p;
+}
+
 {
   # shamelessly stolen from HTTP::Body::UrlEncoded by Christian Hansen
 

diff --git a/lib/Web/Simple.pm b/lib/Web/Simple.pm
index 29c9933..e548ef2 100644 (file)
--- a/lib/Web/Simple.pm
+++ b/lib/Web/Simple.pm
@@ -461,7 +461,12 @@ Query and body parameters can be match via
 
 The body spec will match if the request content is either
 application/x-www-form-urlencoded or multipart/form-data - the latter
-of which is required for uploads - see below.
+of which is required for uploads - see below. Both parameter names and values
+will be decoded according to the parameter encoding attribute of the
+Web::Simple::Application object, which is set to UTF-8 by default. It can be
+configured by adding a sub called default_param_encoding to your class, which
+returns the name of the encoding your parameters are in, or undef to disable
+parameter decoding.
 
 The param spec is elements of one of the following forms -
 

diff --git a/lib/Web/Simple/Application.pm b/lib/Web/Simple/Application.pm
index 1ec59aa..cbbd825 100644 (file)
--- a/lib/Web/Simple/Application.pm
+++ b/lib/Web/Simple/Application.pm
@@ -20,6 +20,10 @@ has 'config' => (
 
 sub default_config { () }
 
+has param_encoding => (is => "lazy");
+
+sub _build_param_encoding { "UTF-8" }
+
 has '_dispatcher' => (is => 'lazy');
 
 sub _build__dispatcher {
@@ -40,7 +44,10 @@ sub _build__dispatcher {
   my $node_args = { app_object => $self };
   weaken($node_args->{app_object});
   Web::Dispatch->new(
-    app => sub { $self->dispatch_request(@_), $final },
+    app => sub {
+      { "Web::Dispatch::ParamParser.param_encoding" => $self->param_encoding },
+      $self->dispatch_request(@_), $final;
+    },
     node_class => 'Web::Simple::DispatchNode',
     node_args => $node_args
   );

diff --git a/t/post.t b/t/post.t
index d7eeb1d..7e6e02a 100644 (file)
--- a/t/post.t
+++ b/t/post.t
@@ -2,6 +2,7 @@ use strict;
 use warnings FATAL => 'all';
 
 use Test::More qw(no_plan);
+use Encode 'decode_utf8';
 
 {
   use Web::Simple 'PostTest';
@@ -106,3 +107,24 @@ is(
   'TESTFILE',
   'Actual upload returns filename ok'
 );
+
+my $utf8_req =  POST "http://localhost"
+  => Content_Type => "form-data"
+  => Content => [ foo => "FOOü", bar => "BAR" ];
+my $utf8_expect = "FOOü BAR";
+
+my $utf8 = run_request($utf8_req);
+is($utf8->content, decode_utf8($utf8_expect), "params utf8-decoded by default");
+
+my $utf8_bytes = PostTest->new( param_encoding => undef )
+  ->run_test_request($utf8_req);
+is($utf8_bytes->content, $utf8_expect, "disabling the param encoding works");
+
+my $iso_req =  POST "http://localhost"
+  => Content_Type => "form-data"
+  => Content => [ foo => "FOO\x{FC}", bar => "BAR" ];
+my $iso = PostTest->new( param_encoding => "iso-8859-15" )
+  ->run_test_request($iso_req);
+is($iso->content, "FOO\x{FC} BAR", "changing the param encoding works");
+
+1;