[],
'GET|POST|DELETE does not match PUT'
);
+
+my $nest = $dp->parse_dispatch_specification('(GET+/foo)|POST');
+
+is_deeply(
+ [ $nest->({ PATH_INFO => '/foo', REQUEST_METHOD => 'GET' }) ],
+ [ {} ],
+ '(GET+/foo)|POST matches GET /foo'
+);
+
+is_deeply(
+ [ $nest->({ PATH_INFO => '/bar', REQUEST_METHOD => 'GET' }) ],
+ [],
+ '(GET+/foo)|POST does not match GET /bar'
+);
+
+is_deeply(
+ [ $nest->({ PATH_INFO => '/bar', REQUEST_METHOD => 'POST' }) ],
+ [ {} ],
+ '(GET+/foo)|POST matches POST /bar'
+);
+
+is_deeply(
+ [ $nest->({ PATH_INFO => '/foo', REQUEST_METHOD => 'PUT' }) ],
+ [],
+ '(GET+/foo)|POST does not match PUT /foo'
+);
+
+{
+ local $@;
+ ok(
+ !eval { $dp->parse_dispatch_specification('/foo+(GET'); 1 },
+ 'Death with missing closing )'
+ );
+ my $err = q{
+ /foo+(GET
+ ^
+ };
+ (s/^\n//s,s/\n $//s,s/^ //mg) for $err;
+ like(
+ $@,
+ qr{\Q$err\E},
+ "Error $@ matches\n${err}\n"
+ );
+}
+
+my $not = $dp->parse_dispatch_specification('!.html+.*');
+
+is_deeply(
+ [ $not->({ PATH_INFO => '/foo.xml' }) ],
+ [ { PATH_INFO => '/foo' }, 'xml' ],
+ '!.html+.* matches /foo.xml'
+);
+
+is_deeply(
+ [ $not->({ PATH_INFO => '/foo.html' }) ],
+ [],
+ '!.html+.* does not match /foo.html'
+);
+
+is_deeply(
+ [ $not->({ PATH_INFO => '/foo' }) ],
+ [],
+ '!.html+.* does not match /foo'
+);
+
+my $sub = $dp->parse_dispatch_specification('/foo/*/...');
+
+is_deeply(
+ [ $sub->({ PATH_INFO => '/foo/1/bar' }) ],
+ [ { PATH_INFO => '/bar' }, 1 ],
+ '/foo/*/... matches /foo/1/bar and strips to /bar'
+);
+
+is_deeply(
+ [ $sub->({ PATH_INFO => '/foo/1/' }) ],
+ [ { PATH_INFO => '/' }, 1 ],
+ '/foo/*/... matches /foo/1/bar and strips to /'
+);
+
+is_deeply(
+ [ $sub->({ PATH_INFO => '/foo/1' }) ],
+ [],
+ '/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"
+ );
+}