[Bps-public-commit] Path-Dispatcher branch, master, updated. a379380aa70134d1b317932743e7c03e1d4e5bf4
sartak at bestpractical.com
sartak at bestpractical.com
Fri Dec 18 19:35:39 EST 2009
The branch, master has been updated
via a379380aa70134d1b317932743e7c03e1d4e5bf4 (commit)
via cb47b4b9aaa3aae550b94d0d169ef5852d47c16f (commit)
via 8fe3edd918ea18f494d380af3432aa04997ddb1d (commit)
via e0d23b3939e3ae6d47ce3437e1ada7d690db41b0 (commit)
via 301d1354d9b8468a7861c203dcf2973ef154faff (commit)
via 8bc5f7478a49c19528c1eb9fdcd9fdfb02723546 (commit)
via fd41e0f526652b4ab562959a10aaefb6d63137bd (commit)
via 318997cdc782ef5c4f1f46d454bdc2e156159868 (commit)
via ca495a52aec12c6ff6077903a6109afcc0886080 (commit)
via 5178ffc5ff4cead6f7d1dee4b4757296b30196da (commit)
via 7f66ddf66a1d3a0f4908d96a9a4d5669db2788ea (commit)
via d3c829adb17dc791e379ec829f76d608c7497b81 (commit)
via 61d055f4b1ca9f6d32bc1ce90592d641b2ef30f7 (commit)
via 7f325bba3846f379138a66b0efdab83aef21082a (commit)
via e5537d5c688960cbb2bb64f284e52d4beb6020c3 (commit)
via b413c7b90bdfd20fc0d434e1a8f041251d1ebfad (commit)
via 73651995cc01ec487269df30df6a8d068e8ac4d1 (commit)
via 8d755313db504b46fc06c61966b7a5ea58ae85a0 (commit)
via d9822a3ca5065679dab760f0fedb686d4996e2e4 (commit)
via b030e4d46e9ec28153a6c928585c94227eeda2a2 (commit)
via cd6e2c20ccb9e7e2f5e931fcb7665be02e063a9f (commit)
via fc46b77711f36fd3cfa9c5b1dc22958e76789ea6 (commit)
via 1c60e67ae7a60506437b3eb6fac82e66723e65fc (commit)
via b4b9b274486eb400b834aba38d7eaa143e79d0d7 (commit)
via 6a50803ebdafabecafee609d8af38e53cf13d9a2 (commit)
via db8923dfc1aaca894e737c01bb572456984a6b68 (commit)
via 527dbedabc6bd6f60839f9794d6fc08118146b77 (commit)
via 897c175070e0ec4ef966cf8746035c04d66c452c (commit)
from 2de397d0251e2d152638a7fd3dc6bc431afce238 (commit)
Summary of changes:
lib/Path/Dispatcher.pm | 15 +++++
lib/Path/Dispatcher/Cookbook.pod | 6 +-
lib/Path/Dispatcher/Declarative.pm | 2 +-
lib/Path/Dispatcher/Match.pm | 2 +-
lib/Path/Dispatcher/Rule.pm | 18 ++++++-
lib/Path/Dispatcher/Rule/Eq.pm | 16 +++++-
lib/Path/Dispatcher/Rule/Tokens.pm | 104 +++++++++++++++++++++++------------
lib/Path/Dispatcher/Rule/Under.pm | 25 ++++++++-
t/020-chain.t | 5 --
t/100-declarative.t | 2 +-
t/300-complete-simple.t | 53 ++++++++++++++++++
t/301-complete-complex.t | 73 +++++++++++++++++++++++++
t/302-complete-delimiter.t | 57 ++++++++++++++++++++
13 files changed, 328 insertions(+), 50 deletions(-)
create mode 100644 t/300-complete-simple.t
create mode 100644 t/301-complete-complex.t
create mode 100644 t/302-complete-delimiter.t
- Log -----------------------------------------------------------------
commit 897c175070e0ec4ef966cf8746035c04d66c452c
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 17:39:37 2009 -0500
Basic tests for completion
diff --git a/t/300-complete-simple.t b/t/300-complete-simple.t
new file mode 100644
index 0000000..50ef538
--- /dev/null
+++ b/t/300-complete-simple.t
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+do {
+ package MyApp::Dispatcher;
+ use Path::Dispatcher::Declarative -base;
+
+ on qr/(b)(ar)(.*)/ => sub { die "do not call blocks!" };
+ on ['token', 'matching'] => sub { die "do not call blocks!" };
+
+ rewrite quux => 'bar';
+ rewrite qr/^quux-(.*)/ => sub { "bar:$1" };
+
+ on alpha => sub { die "do not call blocks!" };
+
+ under alpha => sub {
+ then { die "do not call blocks!" };
+ on one => sub { die "do not call blocks!" };
+ then { die "do not call blocks!" };
+ on two => sub { die "do not call blocks!" };
+ on three => sub { die "do not call blocks!" };
+ };
+};
+
+my $dispatcher = MyApp::Dispatcher->dispatcher;
+is_deeply([$dispatcher->complete('x')], [], 'no completions for "x"');
+is_deeply([$dispatcher->complete('a')], ['alpha'], 'one completion for "a"');
+is_deeply([$dispatcher->complete('alpha')], ['one', 'two', 'three'], 'three completions for "alpha"');
+is_deeply([$dispatcher->complete('q')], ['quux'], 'one completion for "quux"');
+
+TODO: {
+ local $TODO = "cannot complete regex rules (yet!)";
+ is_deeply([$dispatcher->complete('quux')], ['quux-'], 'one completion for "quux"');
+ is_deeply([$dispatcher->complete('b')], ['bar'], 'one completion for "bar"');
+};
+
commit 527dbedabc6bd6f60839f9794d6fc08118146b77
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 17:41:19 2009 -0500
Add stub complete method
diff --git a/lib/Path/Dispatcher.pm b/lib/Path/Dispatcher.pm
index 0fbd066..422e0c9 100644
--- a/lib/Path/Dispatcher.pm
+++ b/lib/Path/Dispatcher.pm
@@ -69,6 +69,15 @@ sub run {
return $dispatch->run(@_);
}
+sub complete {
+ my $self = shift;
+ my $start = shift;
+
+ my @completions;
+
+ return @completions;
+}
+
# We don't export anything, so if they request something, then try to error
# helpfully
sub import {
commit db8923dfc1aaca894e737c01bb572456984a6b68
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 17:50:55 2009 -0500
Okay this one is not simple!
diff --git a/t/300-complete-simple.t b/t/301-complete-complex.t
similarity index 100%
rename from t/300-complete-simple.t
rename to t/301-complete-complex.t
commit 6a50803ebdafabecafee609d8af38e53cf13d9a2
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 17:51:08 2009 -0500
Add an actually-simple test
diff --git a/t/300-complete-simple.t b/t/300-complete-simple.t
new file mode 100644
index 0000000..cc35ddc
--- /dev/null
+++ b/t/300-complete-simple.t
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+do {
+ package MyApp::Dispatcher;
+ use Path::Dispatcher::Declarative -base;
+
+ on foo => sub { die "do not call blocks!" };
+ on bar => sub { die "do not call blocks!" };
+ on baz => sub { die "do not call blocks!" };
+};
+
+my $dispatcher = MyApp::Dispatcher->dispatcher;
+is_deeply([$dispatcher->complete('x')], [], 'no completions for "x"');
+is_deeply([$dispatcher->complete('foooo')], [], 'no completions for "foooo"');
+is_deeply([$dispatcher->complete('baq')], [], 'no completions for "baq"');
+
+is_deeply([$dispatcher->complete('f')], ['foo'], 'one completion for "f"');
+is_deeply([$dispatcher->complete('fo')], ['foo'], 'one completion for "fo"');
+is_deeply([$dispatcher->complete('foo')], ['foo'], 'one completion for "foo"');
+
+is_deeply([$dispatcher->complete('b')], ['bar', 'baz'], 'two completions for "b"');
+is_deeply([$dispatcher->complete('ba')], ['bar', 'baz'], 'two completions for "ba"');
+is_deeply([$dispatcher->complete('bar')], ['bar'], 'one completion for "bar"');
+is_deeply([$dispatcher->complete('baz')], ['baz'], 'one completion for "baz"');
+
commit b4b9b274486eb400b834aba38d7eaa143e79d0d7
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 17:59:54 2009 -0500
Refactor _prefix_match out to let rules simplify their match logic
diff --git a/lib/Path/Dispatcher/Rule.pm b/lib/Path/Dispatcher/Rule.pm
index dc8e3a4..1dbafd4 100644
--- a/lib/Path/Dispatcher/Rule.pm
+++ b/lib/Path/Dispatcher/Rule.pm
@@ -27,7 +27,14 @@ sub match {
my $self = shift;
my $path = shift;
- my ($result, $leftover) = $self->_match($path);
+ my ($result, $leftover);
+
+ if ($self->prefix) {
+ ($result, $leftover) = $self->_prefix_match($path);
+ }
+ else {
+ ($result, $leftover) = $self->_match($path);
+ }
if (!$result) {
$self->trace(leftover => $leftover, match => undef, path => $path)
@@ -60,6 +67,11 @@ sub match {
return $match;
}
+sub _prefix_match {
+ my $self = shift;
+ return $self->_match(@_);
+}
+
sub run {
my $self = shift;
diff --git a/lib/Path/Dispatcher/Rule/Eq.pm b/lib/Path/Dispatcher/Rule/Eq.pm
index 684a7e7..0a9425e 100644
--- a/lib/Path/Dispatcher/Rule/Eq.pm
+++ b/lib/Path/Dispatcher/Rule/Eq.pm
@@ -12,7 +12,12 @@ sub _match {
my $self = shift;
my $path = shift;
- return $path->path eq $self->string unless $self->prefix;
+ return $path->path eq $self->string;
+}
+
+sub _prefix_match {
+ my $self = shift;
+ my $path = shift;
my $truncated = substr($path->path, 0, length($self->string));
return 0 unless $truncated eq $self->string;
commit 1c60e67ae7a60506437b3eb6fac82e66723e65fc
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:02:48 2009 -0500
_complete for Eq rules
diff --git a/lib/Path/Dispatcher/Rule/Eq.pm b/lib/Path/Dispatcher/Rule/Eq.pm
index 0a9425e..b0f3b10 100644
--- a/lib/Path/Dispatcher/Rule/Eq.pm
+++ b/lib/Path/Dispatcher/Rule/Eq.pm
@@ -25,6 +25,15 @@ sub _prefix_match {
return (1, substr($path->path, length($self->string)));
}
+sub _complete {
+ my $self = shift;
+ my $path = shift->path;
+ my $completed = $self->string;
+
+ return unless substr($completed, 0, length($path)) eq $path;
+ return $completed;
+}
+
sub readable_attributes { q{"} . shift->string . q{"} }
__PACKAGE__->meta->make_immutable;
commit fc46b77711f36fd3cfa9c5b1dc22958e76789ea6
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:05:02 2009 -0500
Promote complete to a public method; stub for all Rules
diff --git a/lib/Path/Dispatcher/Rule.pm b/lib/Path/Dispatcher/Rule.pm
index 1dbafd4..83ccbe5 100644
--- a/lib/Path/Dispatcher/Rule.pm
+++ b/lib/Path/Dispatcher/Rule.pm
@@ -67,6 +67,10 @@ sub match {
return $match;
}
+sub complete {
+ return (); # no completions
+}
+
sub _prefix_match {
my $self = shift;
return $self->_match(@_);
diff --git a/lib/Path/Dispatcher/Rule/Eq.pm b/lib/Path/Dispatcher/Rule/Eq.pm
index b0f3b10..dd7138a 100644
--- a/lib/Path/Dispatcher/Rule/Eq.pm
+++ b/lib/Path/Dispatcher/Rule/Eq.pm
@@ -25,7 +25,7 @@ sub _prefix_match {
return (1, substr($path->path, length($self->string)));
}
-sub _complete {
+sub complete {
my $self = shift;
my $path = shift->path;
my $completed = $self->string;
commit cd6e2c20ccb9e7e2f5e931fcb7665be02e063a9f
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:07:36 2009 -0500
Test completing on an individual rule
diff --git a/t/300-complete-simple.t b/t/300-complete-simple.t
index cc35ddc..cb5c512 100644
--- a/t/300-complete-simple.t
+++ b/t/300-complete-simple.t
@@ -1,7 +1,17 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More tests => 16;
+use Path::Dispatcher;
+
+my $complete = Path::Dispatcher::Rule::Eq->new(string => "complete");
+is_deeply([$complete->complete(Path::Dispatcher::Path->new('x'))], []);
+is_deeply([$complete->complete(Path::Dispatcher::Path->new('completexxx'))], []);
+is_deeply([$complete->complete(Path::Dispatcher::Path->new('cxxx'))], []);
+
+is_deeply([$complete->complete(Path::Dispatcher::Path->new('c'))], ['complete']);
+is_deeply([$complete->complete(Path::Dispatcher::Path->new('compl'))], ['complete']);
+is_deeply([$complete->complete(Path::Dispatcher::Path->new('complete'))], ['complete']);
do {
package MyApp::Dispatcher;
commit b030e4d46e9ec28153a6c928585c94227eeda2a2
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:15:15 2009 -0500
When we try to complete on a dispatcher, let each rule have at it
diff --git a/lib/Path/Dispatcher.pm b/lib/Path/Dispatcher.pm
index 422e0c9..88ac7ba 100644
--- a/lib/Path/Dispatcher.pm
+++ b/lib/Path/Dispatcher.pm
@@ -70,12 +70,17 @@ sub run {
}
sub complete {
- my $self = shift;
- my $start = shift;
+ my $self = shift;
+ my $path = shift;
- my @completions;
+ # Automatically box paths
+ unless (blessed($path) && $path->isa('Path::Dispatcher::Path')) {
+ $path = $self->path_class->new(
+ path => $path,
+ );
+ }
- return @completions;
+ return map { $_->complete($path) } $self->rules;
}
# We don't export anything, so if they request something, then try to error
commit d9822a3ca5065679dab760f0fedb686d4996e2e4
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:20:38 2009 -0500
Refactor Token matching into something with a callback
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index e9c6059..34c53ba 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -60,28 +60,45 @@ sub _match {
return \@matched, $leftover;
}
-sub _match_token {
+sub _each_token {
my $self = shift;
my $got = shift;
my $expected = shift;
+ my $callback = shift;
- if (!ref($expected)) {
- ($got, $expected) = (lc $got, lc $expected) if !$self->case_sensitive;
- return $got eq $expected;
- }
- elsif (ref($expected) eq 'ARRAY') {
+ if (ref($expected) eq 'ARRAY') {
for my $alternative (@$expected) {
- return 1 if $self->_match_token($got, $alternative);
+ $self->_each_token($got, $alternative, $callback);
}
}
- elsif (ref($expected) eq 'Regexp') {
- return $got =~ $expected;
+ elsif (!ref($expected) || ref($expected) eq 'Regexp') {
+ $callback->($got, $expected);
}
else {
die "Unexpected token '$expected'"; # the irony is not lost on me :)
}
}
+sub _match_token {
+ my $self = shift;
+ my $got = shift;
+ my $expected = shift;
+
+ my $matched = 0;
+ $self->_each_token($got, $expected, sub {
+ my ($g, $e) = @_;
+ if (!ref($e)) {
+ ($g, $e) = (lc $g, lc $e) if !$self->case_sensitive;
+ $matched ||= $g eq $e;
+ }
+ elsif (ref($e) eq 'Regexp') {
+ $matched ||= $g =~ $e;
+ }
+ });
+
+ return $matched;
+}
+
sub tokenize {
my $self = shift;
my $path = shift;
commit 8d755313db504b46fc06c61966b7a5ea58ae85a0
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:41:12 2009 -0500
Remove tracing from Tokens->_match for now
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index 34c53ba..78d661f 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -30,20 +30,12 @@ sub _match {
for my $expected ($self->tokens) {
unless (@tokens) {
- $self->trace(no_tokens => 1, on_token => $expected, path => $path)
- if $ENV{'PATH_DISPATCHER_TRACE'};
return;
}
my $got = shift @tokens;
unless ($self->_match_token($got, $expected)) {
- $self->trace(
- no_match => 1,
- got_token => $got,
- on_token => $expected,
- path => $path,
- ) if $ENV{'PATH_DISPATCHER_TRACE'};
return;
}
@@ -51,8 +43,6 @@ sub _match {
}
if (@tokens && !$self->prefix) {
- $self->trace(tokens_left => \@tokens, path => $path)
- if $ENV{'PATH_DISPATCHER_TRACE'};
return;
}
commit 73651995cc01ec487269df30df6a8d068e8ac4d1
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:42:47 2009 -0500
Ease refactoring
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index 78d661f..31f77ca 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -26,9 +26,10 @@ sub _match {
my $path = shift;
my @tokens = $self->tokenize($path->path);
+ my @expected = $self->tokens;
my @matched;
- for my $expected ($self->tokens) {
+ while (defined(my $expected = shift @expected)) {
unless (@tokens) {
return;
}
commit b413c7b90bdfd20fc0d434e1a8f041251d1ebfad
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:47:46 2009 -0500
Refactor _match so complete will be able to reuse its logic
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index 31f77ca..8bbc8dd 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -21,34 +21,39 @@ has case_sensitive => (
default => 1,
);
-sub _match {
+sub _match_as_far_as_possible {
my $self = shift;
my $path = shift;
- my @tokens = $self->tokenize($path->path);
+ my @got = $self->tokenize($path->path);
my @expected = $self->tokens;
my @matched;
- while (defined(my $expected = shift @expected)) {
- unless (@tokens) {
- return;
- }
-
- my $got = shift @tokens;
+ while (@got && @expected) {
+ my $expected = $expected[0];
+ my $got = $got[0];
- unless ($self->_match_token($got, $expected)) {
- return;
- }
+ last unless $self->_match_token($got, $expected);
push @matched, $got;
+ shift @expected;
+ shift @got;
}
- if (@tokens && !$self->prefix) {
- return;
- }
+ return (\@matched, \@got, \@expected);
+}
+
+sub _match {
+ my $self = shift;
+ my $path = shift;
+
+ my ($matched, $got, $expected) = $self->_match_as_far_as_possible($path);
+
+ return if @$expected; # didn't provide everything necessary
+ return if @$got && !$self->prefix; # had tokens left over
- my $leftover = $self->untokenize(@tokens);
- return \@matched, $leftover;
+ my $leftover = $self->untokenize(@$got);
+ return $matched, $leftover;
}
sub _each_token {
commit e5537d5c688960cbb2bb64f284e52d4beb6020c3
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:51:16 2009 -0500
A complete method for Tokens
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index 8bbc8dd..8096005 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -56,6 +56,22 @@ sub _match {
return $matched, $leftover;
}
+sub complete {
+ my $self = shift;
+ my $path = shift;
+
+ my ($matched, $got, $expected) = $self->_match_as_far_as_possible($path);
+ return if @$got > 1; # had tokens leftover
+ return if !@$expected; # consumed all tokens
+
+ my $next = shift @$expected;
+ return if ref($next); # we can only deal with strings
+
+ my $part = @$got ? shift @$got : '';
+ return unless substr($next, 0, length($part)) eq $part;
+ return $next;
+}
+
sub _each_token {
my $self = shift;
my $got = shift;
commit 7f325bba3846f379138a66b0efdab83aef21082a
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:52:04 2009 -0500
Complete paths should not return themselves
diff --git a/t/300-complete-simple.t b/t/300-complete-simple.t
index cb5c512..4354f19 100644
--- a/t/300-complete-simple.t
+++ b/t/300-complete-simple.t
@@ -29,10 +29,10 @@ is_deeply([$dispatcher->complete('baq')], [], 'no completions for "baq"');
is_deeply([$dispatcher->complete('f')], ['foo'], 'one completion for "f"');
is_deeply([$dispatcher->complete('fo')], ['foo'], 'one completion for "fo"');
-is_deeply([$dispatcher->complete('foo')], ['foo'], 'one completion for "foo"');
+is_deeply([$dispatcher->complete('foo')], [], '"foo" is already complete');
is_deeply([$dispatcher->complete('b')], ['bar', 'baz'], 'two completions for "b"');
is_deeply([$dispatcher->complete('ba')], ['bar', 'baz'], 'two completions for "ba"');
-is_deeply([$dispatcher->complete('bar')], ['bar'], 'one completion for "bar"');
-is_deeply([$dispatcher->complete('baz')], ['baz'], 'one completion for "baz"');
+is_deeply([$dispatcher->complete('bar')], [], '"bar" is already complete');
+is_deeply([$dispatcher->complete('baz')], [], '"baz" is already complete');
commit 61d055f4b1ca9f6d32bc1ce90592d641b2ef30f7
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 18:55:09 2009 -0500
Kill EOL whitespace
diff --git a/lib/Path/Dispatcher/Cookbook.pod b/lib/Path/Dispatcher/Cookbook.pod
index d26db50..60982d0 100644
--- a/lib/Path/Dispatcher/Cookbook.pod
+++ b/lib/Path/Dispatcher/Cookbook.pod
@@ -21,10 +21,10 @@ C<token_delimiter> method:
package Web::Dispatcher;
use base 'Path::Dispatcher::Declarative';
-
+
use constant token_delimiter => '/';
-
-
+
+
package My::Other::Dispatcher;
use Web::Dispatcher -base;
diff --git a/lib/Path/Dispatcher/Declarative.pm b/lib/Path/Dispatcher/Declarative.pm
index eda3f31..a000ef8 100644
--- a/lib/Path/Dispatcher/Declarative.pm
+++ b/lib/Path/Dispatcher/Declarative.pm
@@ -100,7 +100,7 @@ Path::Dispatcher::Declarative - sugary dispatcher
use Path::Dispatcher::Declarative -base;
on score => sub { show_score() };
-
+
on ['wield', qr/^\w+$/] => sub { wield_weapon($2) };
rewrite qr/^inv/ => "display inventory";
diff --git a/lib/Path/Dispatcher/Match.pm b/lib/Path/Dispatcher/Match.pm
index 5ba67b9..3552d64 100644
--- a/lib/Path/Dispatcher/Match.pm
+++ b/lib/Path/Dispatcher/Match.pm
@@ -59,7 +59,7 @@ sub run_with_number_vars {
my $str = join '', map { defined($_) ? $_ : "" } @_;
# we need to check length because Perl's annoying gotcha of the empty regex
- # actually being an alias for whatever the previously used regex was
+ # actually being an alias for whatever the previously used regex was
# (useful last decade when qr// hadn't been invented)
# we need to do the match anyway, because we have to clear the number vars
($str, $re) = ("x", "x") if length($str) == 0;
diff --git a/lib/Path/Dispatcher/Rule/Under.pm b/lib/Path/Dispatcher/Rule/Under.pm
index a7dcd4e..ce2996e 100644
--- a/lib/Path/Dispatcher/Rule/Under.pm
+++ b/lib/Path/Dispatcher/Rule/Under.pm
@@ -33,7 +33,7 @@ sub match {
# an ::Always (one that will always trigger next_rule if it's block is ran)
#
return unless my @matches = grep { defined } map { $_->match($new_path) } $self->rules;
- pop @matches while @matches && $matches[-1]->rule->isa('Path::Dispatcher::Rule::Chain');
+ pop @matches while @matches && $matches[-1]->rule->isa('Path::Dispatcher::Rule::Chain');
return @matches;
}
diff --git a/t/020-chain.t b/t/020-chain.t
index f775401..6cdb7a7 100644
--- a/t/020-chain.t
+++ b/t/020-chain.t
@@ -108,7 +108,6 @@ do {
on 'create' => sub { push @result, "ticket create" };
chain {
push @result, "(ticket chain just for update)";
-
};
on 'update' => sub { push @result, "ticket update" };
};
@@ -116,26 +115,22 @@ do {
under 'blog' => sub {
chain {
push @result, "(blog chain)";
-
};
under 'post' => sub {
chain {
push @result, "(after post)";
-
};
on 'create' => sub { push @result, "create blog post" };
on 'delete' => sub { push @result, "delete blog post" };
};
chain {
push @result, "(before comment)";
-
};
under 'comment' => sub {
on 'create' => sub { push @result, "create blog comment" };
on 'delete' => sub { push @result, "delete blog comment" };
chain {
push @result, "(never included)";
-
};
};
};
diff --git a/t/100-declarative.t b/t/100-declarative.t
index 3c3ada8..f7868a1 100644
--- a/t/100-declarative.t
+++ b/t/100-declarative.t
@@ -26,7 +26,7 @@ do {
under alpha => sub {
then {
- push @calls, "alpha (chain) ";
+ push @calls, "alpha (chain) ";
};
on one => sub {
push @calls, "one";
commit d3c829adb17dc791e379ec829f76d608c7497b81
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:05:37 2009 -0500
More tests
diff --git a/t/301-complete-complex.t b/t/301-complete-complex.t
index 50ef538..641b526 100644
--- a/t/301-complete-complex.t
+++ b/t/301-complete-complex.t
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 12;
do {
package MyApp::Dispatcher;
@@ -22,6 +22,11 @@ do {
on two => sub { die "do not call blocks!" };
on three => sub { die "do not call blocks!" };
};
+
+ under beta => sub {
+ on a => sub { die "do not call blocks!" };
+ on b => sub { die "do not call blocks!" };
+ };
};
my $dispatcher = MyApp::Dispatcher->dispatcher;
@@ -30,6 +35,13 @@ is_deeply([$dispatcher->complete('a')], ['alpha'], 'one completion for "a"');
is_deeply([$dispatcher->complete('alpha')], ['one', 'two', 'three'], 'three completions for "alpha"');
is_deeply([$dispatcher->complete('q')], ['quux'], 'one completion for "quux"');
+is_deeply([$dispatcher->complete('bet')], ['beta'], 'one completion for "beta"');
+is_deeply([$dispatcher->complete('beta')], ['beta a', 'beta b'], 'two completions for "beta"');
+is_deeply([$dispatcher->complete('beta ')], ['beta a', 'beta b'], 'two completions for "beta "');
+is_deeply([$dispatcher->complete('beta a')], [], 'no completions for "beta a"');
+is_deeply([$dispatcher->complete('beta b')], [], 'no completions for "beta b"');
+is_deeply([$dispatcher->complete('beta c')], [], 'no completions for "beta c"');
+
TODO: {
local $TODO = "cannot complete regex rules (yet!)";
is_deeply([$dispatcher->complete('quux')], ['quux-'], 'one completion for "quux"');
commit 7f66ddf66a1d3a0f4908d96a9a4d5669db2788ea
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:05:41 2009 -0500
complete for Under rules
diff --git a/lib/Path/Dispatcher/Rule/Under.pm b/lib/Path/Dispatcher/Rule/Under.pm
index ce2996e..eb31198 100644
--- a/lib/Path/Dispatcher/Rule/Under.pm
+++ b/lib/Path/Dispatcher/Rule/Under.pm
@@ -37,6 +37,20 @@ sub match {
return @matches;
}
+sub complete {
+ my $self = shift;
+ my $path = shift;
+
+ my $predicate = $self->predicate;
+
+ my $prefix_match = $predicate->match($path)
+ or return $predicate->complete($path);
+
+ my $new_path = $path->clone_path($prefix_match->leftover);
+
+ return map { $_->complete($new_path) } $self->rules;
+}
+
sub readable_attributes { shift->predicate->readable_attributes }
__PACKAGE__->meta->make_immutable;
commit 5178ffc5ff4cead6f7d1dee4b4757296b30196da
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:08:32 2009 -0500
Add the prefix back in when we complete an Under
diff --git a/lib/Path/Dispatcher/Rule/Under.pm b/lib/Path/Dispatcher/Rule/Under.pm
index eb31198..f0350bf 100644
--- a/lib/Path/Dispatcher/Rule/Under.pm
+++ b/lib/Path/Dispatcher/Rule/Under.pm
@@ -48,7 +48,9 @@ sub complete {
my $new_path = $path->clone_path($prefix_match->leftover);
- return map { $_->complete($new_path) } $self->rules;
+ my $prefix = substr($path->path, 0, length($path->path) - length($new_path->path));
+
+ return map { "$prefix$_" } map { $_->complete($new_path) } $self->rules;
}
sub readable_attributes { shift->predicate->readable_attributes }
commit ca495a52aec12c6ff6077903a6109afcc0886080
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:08:45 2009 -0500
complete returns full paths
diff --git a/t/301-complete-complex.t b/t/301-complete-complex.t
index 641b526..53db089 100644
--- a/t/301-complete-complex.t
+++ b/t/301-complete-complex.t
@@ -32,7 +32,7 @@ do {
my $dispatcher = MyApp::Dispatcher->dispatcher;
is_deeply([$dispatcher->complete('x')], [], 'no completions for "x"');
is_deeply([$dispatcher->complete('a')], ['alpha'], 'one completion for "a"');
-is_deeply([$dispatcher->complete('alpha')], ['one', 'two', 'three'], 'three completions for "alpha"');
+is_deeply([$dispatcher->complete('alpha')], ['alpha one', 'alpha two', 'alpha three'], 'three completions for "alpha"');
is_deeply([$dispatcher->complete('q')], ['quux'], 'one completion for "quux"');
is_deeply([$dispatcher->complete('bet')], ['beta'], 'one completion for "beta"');
commit 318997cdc782ef5c4f1f46d454bdc2e156159868
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:10:41 2009 -0500
Remove duplicate completions
diff --git a/lib/Path/Dispatcher.pm b/lib/Path/Dispatcher.pm
index 88ac7ba..3049e27 100644
--- a/lib/Path/Dispatcher.pm
+++ b/lib/Path/Dispatcher.pm
@@ -80,7 +80,8 @@ sub complete {
);
}
- return map { $_->complete($path) } $self->rules;
+ my %seen;
+ return grep { !$seen{$_}++ } map { $_->complete($path) } $self->rules;
}
# We don't export anything, so if they request something, then try to error
commit fd41e0f526652b4ab562959a10aaefb6d63137bd
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:18:15 2009 -0500
A fix for, and more tests for, token matching
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index 8096005..8e4fb86 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -69,7 +69,7 @@ sub complete {
my $part = @$got ? shift @$got : '';
return unless substr($next, 0, length($part)) eq $part;
- return $next;
+ return $self->untokenize(@$matched, $next);
}
sub _each_token {
diff --git a/t/301-complete-complex.t b/t/301-complete-complex.t
index 53db089..883371a 100644
--- a/t/301-complete-complex.t
+++ b/t/301-complete-complex.t
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 12;
+use Test::More tests => 17;
do {
package MyApp::Dispatcher;
@@ -31,8 +31,17 @@ do {
my $dispatcher = MyApp::Dispatcher->dispatcher;
is_deeply([$dispatcher->complete('x')], [], 'no completions for "x"');
+
is_deeply([$dispatcher->complete('a')], ['alpha'], 'one completion for "a"');
is_deeply([$dispatcher->complete('alpha')], ['alpha one', 'alpha two', 'alpha three'], 'three completions for "alpha"');
+
+is_deeply([$dispatcher->complete('t')], ['token'], 'one completion for "t"');
+is_deeply([$dispatcher->complete('token')], ['token matching'], 'one completion for "token"');
+is_deeply([$dispatcher->complete('token ')], ['token matching'], 'one completion for "token "');
+is_deeply([$dispatcher->complete('token m')], ['token matching'], 'one completion for "token m"');
+is_deeply([$dispatcher->complete('token matchin')], ['token matching'], 'one completion for "token matchin"');
+is_deeply([$dispatcher->complete('token matching')], [], 'no completions for "token matching"');
+
is_deeply([$dispatcher->complete('q')], ['quux'], 'one completion for "quux"');
is_deeply([$dispatcher->complete('bet')], ['beta'], 'one completion for "beta"');
commit 8bc5f7478a49c19528c1eb9fdcd9fdfb02723546
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:18:58 2009 -0500
Handle delimiters infinitesimally better
diff --git a/lib/Path/Dispatcher/Rule/Under.pm b/lib/Path/Dispatcher/Rule/Under.pm
index f0350bf..4b270d1 100644
--- a/lib/Path/Dispatcher/Rule/Under.pm
+++ b/lib/Path/Dispatcher/Rule/Under.pm
@@ -50,7 +50,7 @@ sub complete {
my $prefix = substr($path->path, 0, length($path->path) - length($new_path->path));
- return map { "$prefix$_" } map { $_->complete($new_path) } $self->rules;
+ return map { "$prefix $_" } map { $_->complete($new_path) } $self->rules;
}
sub readable_attributes { shift->predicate->readable_attributes }
commit 301d1354d9b8468a7861c203dcf2973ef154faff
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:24:51 2009 -0500
Refactor tests to use new complete_ok
diff --git a/t/301-complete-complex.t b/t/301-complete-complex.t
index 883371a..f57b02e 100644
--- a/t/301-complete-complex.t
+++ b/t/301-complete-complex.t
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 16;
do {
package MyApp::Dispatcher;
@@ -30,30 +30,44 @@ do {
};
my $dispatcher = MyApp::Dispatcher->dispatcher;
-is_deeply([$dispatcher->complete('x')], [], 'no completions for "x"');
-is_deeply([$dispatcher->complete('a')], ['alpha'], 'one completion for "a"');
-is_deeply([$dispatcher->complete('alpha')], ['alpha one', 'alpha two', 'alpha three'], 'three completions for "alpha"');
+sub complete_ok {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my $path = shift;
+ my @expected = @_;
-is_deeply([$dispatcher->complete('t')], ['token'], 'one completion for "t"');
-is_deeply([$dispatcher->complete('token')], ['token matching'], 'one completion for "token"');
-is_deeply([$dispatcher->complete('token ')], ['token matching'], 'one completion for "token "');
-is_deeply([$dispatcher->complete('token m')], ['token matching'], 'one completion for "token m"');
-is_deeply([$dispatcher->complete('token matchin')], ['token matching'], 'one completion for "token matchin"');
-is_deeply([$dispatcher->complete('token matching')], [], 'no completions for "token matching"');
+ my @got = $dispatcher->complete($path);
-is_deeply([$dispatcher->complete('q')], ['quux'], 'one completion for "quux"');
+ my $message = @expected == 0 ? "no completions"
+ : @expected == 1 ? "one completion"
+ : @expected . " completions";
+ $message .= " for path '$path'";
-is_deeply([$dispatcher->complete('bet')], ['beta'], 'one completion for "beta"');
-is_deeply([$dispatcher->complete('beta')], ['beta a', 'beta b'], 'two completions for "beta"');
-is_deeply([$dispatcher->complete('beta ')], ['beta a', 'beta b'], 'two completions for "beta "');
-is_deeply([$dispatcher->complete('beta a')], [], 'no completions for "beta a"');
-is_deeply([$dispatcher->complete('beta b')], [], 'no completions for "beta b"');
-is_deeply([$dispatcher->complete('beta c')], [], 'no completions for "beta c"');
+ is_deeply(\@got, \@expected, $message);
+}
+
+complete_ok('x');
+
+complete_ok(q => 'quux');
+
+complete_ok(a => 'alpha');
+complete_ok(alpha => 'alpha one', 'alpha two', 'alpha three');
+
+complete_ok(t => 'token');
+complete_ok(token => 'token matching');
+complete_ok('token m' => 'token matching');
+complete_ok('token matchin' => 'token matching');
+complete_ok('token matching');
+
+complete_ok(bet => 'beta');
+complete_ok(beta => 'beta a', 'beta b');
+complete_ok('beta a');
+complete_ok('beta b');
+complete_ok('beta c');
TODO: {
local $TODO = "cannot complete regex rules (yet!)";
- is_deeply([$dispatcher->complete('quux')], ['quux-'], 'one completion for "quux"');
- is_deeply([$dispatcher->complete('b')], ['bar'], 'one completion for "bar"');
+ complete_ok(quux => 'quux-');
+ complete_ok(b => 'bar', 'beta');
};
commit e0d23b3939e3ae6d47ce3437e1ada7d690db41b0
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:26:40 2009 -0500
Another complete_ok refactor
diff --git a/t/300-complete-simple.t b/t/300-complete-simple.t
index 4354f19..fa5479e 100644
--- a/t/300-complete-simple.t
+++ b/t/300-complete-simple.t
@@ -23,16 +23,31 @@ do {
};
my $dispatcher = MyApp::Dispatcher->dispatcher;
-is_deeply([$dispatcher->complete('x')], [], 'no completions for "x"');
-is_deeply([$dispatcher->complete('foooo')], [], 'no completions for "foooo"');
-is_deeply([$dispatcher->complete('baq')], [], 'no completions for "baq"');
-
-is_deeply([$dispatcher->complete('f')], ['foo'], 'one completion for "f"');
-is_deeply([$dispatcher->complete('fo')], ['foo'], 'one completion for "fo"');
-is_deeply([$dispatcher->complete('foo')], [], '"foo" is already complete');
-
-is_deeply([$dispatcher->complete('b')], ['bar', 'baz'], 'two completions for "b"');
-is_deeply([$dispatcher->complete('ba')], ['bar', 'baz'], 'two completions for "ba"');
-is_deeply([$dispatcher->complete('bar')], [], '"bar" is already complete');
-is_deeply([$dispatcher->complete('baz')], [], '"baz" is already complete');
+sub complete_ok {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my $path = shift;
+ my @expected = @_;
+
+ my @got = $dispatcher->complete($path);
+
+ my $message = @expected == 0 ? "no completions"
+ : @expected == 1 ? "one completion"
+ : @expected . " completions";
+ $message .= " for path '$path'";
+
+ is_deeply(\@got, \@expected, $message);
+}
+
+complete_ok('x');
+complete_ok('foooo');
+complete_ok('baq');
+
+complete_ok(f => 'foo');
+complete_ok(fo => 'foo');
+complete_ok('foo');
+
+complete_ok('b' => 'bar', 'baz');
+complete_ok('ba' => 'bar', 'baz');
+complete_ok('bar');
+complete_ok('baz');
commit 8fe3edd918ea18f494d380af3432aa04997ddb1d
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:31:09 2009 -0500
Painful delimiter tests
diff --git a/t/302-complete-delimiter.t b/t/302-complete-delimiter.t
new file mode 100644
index 0000000..3f9f46a
--- /dev/null
+++ b/t/302-complete-delimiter.t
@@ -0,0 +1,57 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 18;
+
+do {
+ package MyApp::Dispatcher;
+ use Path::Dispatcher::Declarative -base, -default => {
+ token_delimiter => '/',
+ };
+
+ on ['token', 'matching'] => sub { die "do not call blocks!" };
+
+ under alpha => sub {
+ on one => sub { die "do not call blocks!" };
+ on two => sub { die "do not call blocks!" };
+ on three => sub { die "do not call blocks!" };
+ };
+};
+
+my $dispatcher = MyApp::Dispatcher->dispatcher;
+
+sub complete_ok {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my $path = shift;
+ my @expected = @_;
+
+ my @got = $dispatcher->complete($path);
+
+ my $message = @expected == 0 ? "no completions"
+ : @expected == 1 ? "one completion"
+ : @expected . " completions";
+ $message .= " for path '$path'";
+
+ is_deeply(\@got, \@expected, $message);
+}
+
+complete_ok(t => 'token');
+complete_ok(toke => 'token');
+complete_ok('token' => 'token/matching');
+complete_ok('token/' => 'token/matching');
+complete_ok('token/m' => 'token/matching');
+complete_ok('token/matchin' => 'token/matching');
+complete_ok('token/matching');
+complete_ok('token/x');
+complete_ok('token/mx');
+
+complete_ok(a => 'alpha');
+complete_ok(alph => 'alpha');
+complete_ok(alpha => 'alpha/one', 'alpha/two', 'alpha/three');
+complete_ok('alpha/' => 'alpha/one', 'alpha/two', 'alpha/three');
+complete_ok('alpha/o' => 'alpha/one');
+complete_ok('alpha/t' => 'alpha/two', 'alpha/three');
+complete_ok('alpha/tw' => 'alpha/two');
+complete_ok('alpha/th' => 'alpha/three');
+complete_ok('alpha/x');
+
commit cb47b4b9aaa3aae550b94d0d169ef5852d47c16f
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:33:04 2009 -0500
First stab at making delimiters work better
diff --git a/lib/Path/Dispatcher/Rule/Under.pm b/lib/Path/Dispatcher/Rule/Under.pm
index 4b270d1..35574fc 100644
--- a/lib/Path/Dispatcher/Rule/Under.pm
+++ b/lib/Path/Dispatcher/Rule/Under.pm
@@ -50,7 +50,14 @@ sub complete {
my $prefix = substr($path->path, 0, length($path->path) - length($new_path->path));
- return map { "$prefix $_" } map { $_->complete($new_path) } $self->rules;
+ my @completions = map { $_->complete($new_path) } $self->rules;
+
+ if ($predicate->can('untokenize')) {
+ return map { $predicate->untokenize($prefix, $_) } @completions;
+ }
+ else {
+ return map { "$prefix$_" } @completions;
+ }
}
sub readable_attributes { shift->predicate->readable_attributes }
commit a379380aa70134d1b317932743e7c03e1d4e5bf4
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Fri Dec 18 19:34:04 2009 -0500
Remove excess delimiters in untokenize
diff --git a/lib/Path/Dispatcher/Rule/Tokens.pm b/lib/Path/Dispatcher/Rule/Tokens.pm
index 8e4fb86..22367c8 100644
--- a/lib/Path/Dispatcher/Rule/Tokens.pm
+++ b/lib/Path/Dispatcher/Rule/Tokens.pm
@@ -120,7 +120,10 @@ sub tokenize {
sub untokenize {
my $self = shift;
my @tokens = @_;
- return join $self->delimiter, @tokens;
+ return join $self->delimiter,
+ grep { length }
+ map { split $self->delimiter, $_ }
+ @tokens;
}
sub readable_attributes {
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list