implement ?:foo syntax and make ?foo positional

diff --git a/lib/Web/Simple.pm b/lib/Web/Simple.pm
index f65ecb5..a994d66 100644 (file)
--- a/lib/Web/Simple.pm
+++ b/lib/Web/Simple.pm
@@ -448,26 +448,24 @@ The param spec is elements of one of the following forms -
   param=        # required parameter
   @param~       # optional multiple parameter
   @param=       # required multiple parameter
-  *             # include all other parameters
-  @*            # include all other parameters as multiple
+  :param~       # optional parameter in hashref
+  :param=       # required parameter in hashref
+  :@param~      # optional multiple in hashref
+  :@param=      # required multiple in hashref
+  *             # include all other parameters in hashref
+  @*            # include all other parameters as multiple in hashref
 
-separated by the & character.
+separated by the & character. The arguments added to the request are
+one per non-:/* parameter (scalar for normal, arrayref for multiple),
+plus if any :/* specs exist a hashref containing those values.
 
 So, to match a page parameter with an optional order_by parameter one
 would write:
 
   sub (?page=&order_by~) {
-
-Parameters selected are turned into a hashref; in the case of singular
-parameters then if multiple values are found the last one is used. In the
-case of multiple parameters an arrayref of all values (or an empty arrayref
-for a missing optional) is used. The resulting hashref is provided as a
-match argument. So we might write something like:
-
-  sub (?page=&order_by~) {
-    my ($self, $p) = @_;
-    return unless $p->{page} =~ /^\d+$/;
-    $p->{order_by} ||= 'id';
+    my ($self, $page, $order_by) = @_;
+    return unless $page =~ /^\d+$/;
+    $page ||= 'id';
     response_filter {
       $_[1]->search_rs({}, $p);
     }
@@ -475,6 +473,12 @@ match argument. So we might write something like:
 
 to implement paging and ordering against a L<DBIx::Class::ResultSet> object.
 
+To get all parameters as a hashref of arrayrefs, write:
+
+  sub(?@*) {
+    my ($self, $params) = @_;
+    ...
+
 =head3 Combining matches
 
 Matches may be combined with the + character - e.g.

diff --git a/lib/Web/Simple/DispatchParser.pm b/lib/Web/Simple/DispatchParser.pm
index 0fe2c5a..1759622 100644 (file)
--- a/lib/Web/Simple/DispatchParser.pm
+++ b/lib/Web/Simple/DispatchParser.pm
@@ -230,23 +230,28 @@ 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, %positional, $have_kw);
+    my $pos_idx = 0;
     PARAM: { do {
 
-      # per param flag
+      # ?:foo or ?@:foo
 
-      my $multi = 0;
+      my $is_kw = /\G\:/gc;
 
       # ?@foo or ?@*
 
-      /\G\@/gc and $multi = 1;
+      my $multi = /\G\@/gc;
 
       # @* or *
 
       if (/\G\*/gc) {
 
+        $self->_blam("* is always named; no need to supply :") if $is_kw;
+
         $multi ? ($multistar = 1) : ($star = 1);
 
+        $have_kw = 1;
+
         if ($star && $multistar) {
           $self->_blam("Can't use * and \@* in the same parameter match");
         }
@@ -267,6 +272,10 @@ sub _parse_param_handler {
         # record the key in the right category depending on the multi (@) flag
 
         $multi ? ($multi{$name} = 1) : (push @single, $name);
+
+        # record positional or keyword
+
+        $is_kw ? ($have_kw = 1) : ($positional{$name} = $pos_idx++);
       }
     } while (/\G\&/gc) }
 
@@ -275,7 +284,8 @@ sub _parse_param_handler {
       foreach my $name (@required) {
         return unless exists $raw->{$name};
       }
-      my %p;
+      my (%p, %done);
+      my @p = (undef) x $pos_idx;
       foreach my $name (
         @single,
         ($star
@@ -283,18 +293,30 @@ sub _parse_param_handler {
           : ()
         )
       ) {
-        $p{$name} = $raw->{$name}->[-1] if exists $raw->{$name};
+        if (exists $raw->{$name}) {
+          if (exists $positional{$name}) {
+            $p[$positional{$name}] = $raw->{$name}->[-1];
+          } else {
+            $p{$name} = $raw->{$name}->[-1];
+          }
+        }
+        $done{$name} = 1;
       }
       foreach my $name (
         keys %multi,
         ($multistar
-          ? (grep { !exists $p{$_} } keys %$raw)
+          ? (grep { !exists $done{$_} && !exists $multi{$_} } keys %$raw)
           : ()
         )
       ) {
-        $p{$name} = $raw->{$name}||[];
+        if (exists $positional{$name}) {
+          $p[$positional{$name}] = $raw->{$name}||[];
+        } else {
+          $p{$name} = $raw->{$name}||[];
+        }
       }
-      return ({}, \%p);
+      $p[$pos_idx] = \%p if $have_kw;
+      return ({}, @p);
     };
   }
 }

diff --git a/t/dispatch_parser.t b/t/dispatch_parser.t
index a001b41..f8e7e06 100644 (file)
--- a/t/dispatch_parser.t
+++ b/t/dispatch_parser.t
@@ -240,33 +240,49 @@ my %all_multi = (
   evil => [ '/' ],
 );
 
-my $foo = $dp->parse_dispatch_specification('?foo=');
+foreach my $lose ('?foo=','?:foo=','?@foo=','?:@foo=') {
+  my $foo = $dp->parse_dispatch_specification($lose);
 
-is_deeply(
-  [ $foo->({ QUERY_STRING => '' }) ],
-  [],
-  '?foo= fails with no query'
-);
+  is_deeply(
+    [ $foo->({ QUERY_STRING => '' }) ],
+    [],
+    "${lose} fails with no query"
+  );
+
+  is_deeply(
+    [ $foo->({ QUERY_STRING => 'bar=baz' }) ],
+    [],
+    "${lose} fails with query missing foo key"
+  );
+}
 
 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 => '/' } ],
+  [ '?foo=' => 'FOO' ],
+  [ '?:foo=' => { foo => 'FOO' } ],
+  [ '?spoo~' => undef ],
+  [ '?:spoo~' => {} ],
+  [ '?@spoo~' => [] ],
+  [ '?:@spoo~' => { spoo => [] } ],
+  [ '?bar=' => 'BAR2' ],
+  [ '?:bar=' => { bar => 'BAR2' } ],
+  [ '?@bar=' => [ qw(BAR1 BAR2) ] ],
+  [ '?:@bar=' => { bar => [ qw(BAR1 BAR2) ] } ],
+  [ '?foo=&@bar=' => 'FOO', [ qw(BAR1 BAR2) ] ],
+  [ '?foo=&:@bar=' => 'FOO', { 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) ] } ],
+  [ '?foo=&@*' => 'FOO', do { my %h = %all_multi; delete $h{foo}; \%h } ],
+  [ '?:foo=&@*' => { %all_multi, foo => 'FOO' } ],
+  [ '?:@bar=&*' => { %all_single, bar => [ qw(BAR1 BAR2) ] } ],
 ) {
-  my ($spec, $res) = @$win;
+  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 ],
+    [ {}, @res ],
     "${spec} matches correctly"
   );
 }