X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FWeb%2FSimple%2FDispatchParser.pm;h=175962248918bdb11cdf80639203e2de7dcbdb31;hb=eb9e0e25ce6999be81b80424ccb16d04966debed;hp=0fe2c5a7bfe64adad48bfe208e445622f0659bae;hpb=92e23550709cc075dd06e14d50dc302d0b405977;p=catagits%2FWeb-Simple.git 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); }; } }