From: Matt S Trout Date: Tue, 24 Nov 2009 21:28:56 +0000 (-0500) Subject: implement ?:foo syntax and make ?foo positional X-Git-Tag: v0.003~38 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FWeb-Simple.git;a=commitdiff_plain;h=eb9e0e25ce6999be81b80424ccb16d04966debed implement ?:foo syntax and make ?foo positional --- diff --git a/lib/Web/Simple.pm b/lib/Web/Simple.pm index f65ecb5..a994d66 100644 --- 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 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 --- 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 --- 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" ); }