handle empty query parameters

[catagits/Web-Simple.git] / lib / Web / Dispatch / ParamParser.pm

diff --git a/lib/Web/Dispatch/ParamParser.pm b/lib/Web/Dispatch/ParamParser.pm
index 90c62b1..e55c312 100644 (file)
--- a/lib/Web/Dispatch/ParamParser.pm
+++ b/lib/Web/Dispatch/ParamParser.pm
@@ -3,19 +3,22 @@ package Web::Dispatch::ParamParser;
 use strict;
 use warnings FATAL => 'all';
 
+use Encode 'decode_utf8';
+
 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 ORIG_ENV () { 'Web::Dispatch.original_env' }
 
 sub get_unpacked_query_from {
-  return $_[0]->{+UNPACKED_QUERY} ||= do {
+  return ($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_QUERY} ||= do {
     _unpack_params($_[0]->{QUERY_STRING})
   };
 }
 
 sub get_unpacked_body_from {
-  return $_[0]->{+UNPACKED_BODY} ||= do {
+  return ($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_BODY} ||= do {
     my $ct = lc($_[0]->{CONTENT_TYPE}||'');
     if (!$_[0]->{CONTENT_LENGTH}) {
       {}
@@ -24,7 +27,8 @@ sub get_unpacked_body_from {
       _unpack_params($buf);
     } elsif (index($ct, 'multipart/form-data') >= 0) {
       my $p = get_unpacked_body_object_from($_[0])->param;
-      # forcible arrayification
+      # forcible arrayification (functional, $p does not belong to us,
+      # do NOT replace this with a side-effect ridden "simpler" version)
       +{
         map +(ref($p->{$_}) eq 'ARRAY'
                ? ($_ => $p->{$_})
@@ -39,7 +43,7 @@ sub get_unpacked_body_from {
 
 sub get_unpacked_body_object_from {
   # we may have no object at all - so use a single element arrayref for ||=
-  return ($_[0]->{+UNPACKED_BODY_OBJECT} ||= do {
+  return (($_[0]->{+ORIG_ENV}||$_[0])->{+UNPACKED_BODY_OBJECT} ||= do {
     if (!$_[0]->{CONTENT_LENGTH}) {
       [ undef ]
     } elsif (index(lc($_[0]->{CONTENT_TYPE}||''),'multipart/form-data')==-1) {
@@ -100,9 +104,10 @@ sub get_unpacked_uploads_from {
     (my $params = $_[0]) =~ s/\+/ /g;
     my ($name, $value);
     foreach my $pair (split(/[&;](?:\s+)?/, $params)) {
-      next unless (($name, $value) = split(/=/, $pair, 2)) == 2;
-        
+      $value = 1 unless (($name, $value) = split(/=/, $pair, 2)) == 2;
+
       s/$DECODE/$hex_chr{$1}/gs for ($name, $value);
+      $_ = decode_utf8 $_ for ($name, $value);
 
       push(@{$unpack{$name}||=[]}, $value);
     }