working query parameter handling

diff --git a/lib/Web/Simple/DispatchParser.pm b/lib/Web/Simple/DispatchParser.pm
index 1be1cf2..f665d9f 100644 (file)
--- a/lib/Web/Simple/DispatchParser.pm
+++ b/lib/Web/Simple/DispatchParser.pm
@@ -3,6 +3,17 @@ package Web::Simple::DispatchParser;
 use strict;
 use warnings FATAL => 'all';
 
+sub DEBUG () { 0 }
+
+BEGIN {
+  if ($ENV{WEB_SIMPLE_DISPATCHPARSER_DEBUG}) {
+    no warnings 'redefine';
+    *DEBUG = sub () { 1 }
+  }
+}
+
+sub diag { if (DEBUG) { warn $_[0] } }
+
 sub new { bless({}, ref($_[0])||$_[0]) }
 
 sub _blam {
@@ -215,7 +226,7 @@ sub _parse_param_handler {
   my $unpacker = Web::Simple::ParamParser->can("get_unpacked_${type}_from");
 
   for ($_[1]) {
-    my (@required, @single, %multi, $star, $multistar) = @_;
+    my (@required, @single, %multi, $star, $multistar);
     PARAM: { do {
 
       # per param flag
@@ -228,9 +239,13 @@ sub _parse_param_handler {
 
       # @* or *
 
-      if (/\G\*/) {
+      if (/\G\*/gc) {
 
         $multi ? ($multistar = 1) : ($star = 1);
+
+        if ($star && $multistar) {
+          $self->_blam("Can't use * and \@* in the same parameter match");
+        }
       } else {
 
         # @foo= or foo= or @foo~ or foo~
@@ -247,7 +262,7 @@ sub _parse_param_handler {
 
         # record the key in the right category depending on the multi (@) flag
 
-        $multi ? (push @single, $name) : ($multi{$name} = 1);
+        $multi ? ($multi{$name} = 1) : (push @single, $name);
       }
     } while (/\G\&/gc) }
 

diff --git a/lib/Web/Simple/ParamParser.pm b/lib/Web/Simple/ParamParser.pm
index ad14ab5..e1827d1 100644 (file)
--- a/lib/Web/Simple/ParamParser.pm
+++ b/lib/Web/Simple/ParamParser.pm
@@ -25,8 +25,9 @@ sub get_unpacked_query_from {
 
   sub _unpack_params {
     my %unpack;
+    (my $params = $_[0]) =~ s/\+/ /g;
     my ($name, $value);
-    foreach my $pair (split(/[&;](?:\s+)?/, $_[0])) {
+    foreach my $pair (split(/[&;](?:\s+)?/, $params)) {
       next unless (($name, $value) = split(/=/, $pair, 2)) == 2;
         
       s/$DECODE/$hex_chr{$1}/gs for ($name, $value);

diff --git a/t/dispatch_parser.t b/t/dispatch_parser.t
index 28da3b8..a001b41 100644 (file)
--- a/t/dispatch_parser.t
+++ b/t/dispatch_parser.t
@@ -220,3 +220,53 @@ is_deeply(
   [],
   '/foo/*/... does not match /foo/1 (no trailing /)'
 );
+
+my $q = 'foo=FOO&bar=BAR1&baz=one+two&quux=QUUX1&quux=QUUX2'
+        .'&bar=BAR2&quux=QUUX3&evil=%2F';
+
+my %all_single = (
+  foo => 'FOO',
+  bar => 'BAR2',
+  baz => 'one two',
+  quux => 'QUUX3',
+  evil => '/',
+);
+
+my %all_multi = (
+  foo => [ 'FOO' ],
+  bar => [ qw(BAR1 BAR2) ],
+  baz => [ 'one two' ],
+  quux => [ qw(QUUX1 QUUX2 QUUX3) ],
+  evil => [ '/' ],
+);
+
+my $foo = $dp->parse_dispatch_specification('?foo=');
+
+is_deeply(
+  [ $foo->({ QUERY_STRING => '' }) ],
+  [],
+  '?foo= fails with no query'
+);
+
+foreach my $win (
+  [ '?foo=' => { foo => 'FOO' } ],
+  [ '?spoo~' => { } ],
+  [ '?@spoo~' => { spoo => [] } ],
+  [ '?bar=' => { bar => 'BAR2' } ],
+  [ '?@bar=' => { bar => [ qw(BAR1 BAR2) ] } ],
+  [ '?foo=&@bar=' => { foo => 'FOO', bar => [ qw(BAR1 BAR2) ] } ],
+  [ '?baz=&evil=' => { baz => 'one two', evil => '/' } ],
+  [ '?*' => \%all_single ],
+  [ '?@*' => \%all_multi ],
+  [ '?foo=&@*' => { %all_multi, foo => 'FOO' } ],
+  [ '?@bar=&*' => { %all_single, bar => [ qw(BAR1 BAR2) ] } ],
+) {
+  my ($spec, $res) = @$win;
+  my $match = $dp->parse_dispatch_specification($spec);
+#use Data::Dump::Streamer; warn Dump($match);
+  is_deeply(
+    [ $match->({ QUERY_STRING => $q }) ],
+    [ {}, $res ],
+    "${spec} matches correctly"
+  );
+}