r54991 - in /branches/upstream/libpath-dispatcher-perl/current: ./ lib/Path/ lib/Path/Dispatcher/ lib/Path/Dispatcher/Rule/ t/
nhandler-guest at users.alioth.debian.org
nhandler-guest at users.alioth.debian.org
Mon Mar 29 01:44:15 UTC 2010
Author: nhandler-guest
Date: Mon Mar 29 01:42:57 2010
New Revision: 54991
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54991
Log:
[svn-upgrade] Integrating new upstream version, libpath-dispatcher-perl (0.15)
Added:
branches/upstream/libpath-dispatcher-perl/current/META.yml
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Alternation.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Enum.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Sequence.pm
branches/upstream/libpath-dispatcher-perl/current/t/023-alternation.t
branches/upstream/libpath-dispatcher-perl/current/t/024-sequence.t
branches/upstream/libpath-dispatcher-perl/current/t/025-sequence-custom-rule.t
Removed:
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Builder.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Declarative.pm
branches/upstream/libpath-dispatcher-perl/current/t/016-more-under.t
branches/upstream/libpath-dispatcher-perl/current/t/020-chain.t
branches/upstream/libpath-dispatcher-perl/current/t/021-declarative-defaults.t
branches/upstream/libpath-dispatcher-perl/current/t/100-declarative.t
branches/upstream/libpath-dispatcher-perl/current/t/101-subclass.t
branches/upstream/libpath-dispatcher-perl/current/t/102-abort.t
branches/upstream/libpath-dispatcher-perl/current/t/103-input.t
branches/upstream/libpath-dispatcher-perl/current/t/104-config.t
branches/upstream/libpath-dispatcher-perl/current/t/105-empty.t
branches/upstream/libpath-dispatcher-perl/current/t/106-metadata.t
branches/upstream/libpath-dispatcher-perl/current/t/200-under-next_rule.t
branches/upstream/libpath-dispatcher-perl/current/t/300-complete-simple.t
branches/upstream/libpath-dispatcher-perl/current/t/301-complete-complex.t
branches/upstream/libpath-dispatcher-perl/current/t/302-complete-delimiter.t
branches/upstream/libpath-dispatcher-perl/current/t/303-complete-alternation.t
branches/upstream/libpath-dispatcher-perl/current/t/800-cb-slash-path-delimiter.t
branches/upstream/libpath-dispatcher-perl/current/t/801-cb-chaining.t
Modified:
branches/upstream/libpath-dispatcher-perl/current/Changes
branches/upstream/libpath-dispatcher-perl/current/MANIFEST
branches/upstream/libpath-dispatcher-perl/current/Makefile.PL
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/CodeRef.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Dispatch.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Eq.pm
branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Intersection.pm
branches/upstream/libpath-dispatcher-perl/current/t/017-intersection.t
Modified: branches/upstream/libpath-dispatcher-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/Changes?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/Changes (original)
+++ branches/upstream/libpath-dispatcher-perl/current/Changes Mon Mar 29 01:42:57 2010
@@ -1,6 +1,31 @@
Revision history for Path-Dispatcher
-0.14
+0.15 Tue Mar 16 09:40:40 2009
+ ** Factored Path-Dispatcher-Declarative into its own distribution
+ ** Be sure to update your dependency information!
+
+ Implement ->complete for Rule::Dispatch
+
+ Add Path::Dispatcher::Rule::Alternation
+
+ Implement case insensitivity fory Rule::Eq
+
+ Add Path::Dispatcher::Rule::Sequence - like Rule::Tokens but
+ better!
+
+ Add Path::Dispatcher::Rule::Enum
+
+ Path autoboxing has been factored out into a private method for
+ more overridability
+
+ A few documentation improvements as usual :)
+
+0.14 Thu Dec 31 13:18:19 2009
+ Add Path::Dispatcher->complete for tab-completion
+
+ Handle delimiters better in Path::Dispatcher::Rule::Tokens
+
+ Factor out a _prefix method for rules to simplify their logic
0.13 Sun Aug 9 13:38:19 2009
Add unshift_rule to classes that do Role::Rules
Modified: branches/upstream/libpath-dispatcher-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/MANIFEST?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/MANIFEST (original)
+++ branches/upstream/libpath-dispatcher-perl/current/MANIFEST Mon Mar 29 01:42:57 2010
@@ -8,27 +8,29 @@
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Path/Dispatcher.pm
-lib/Path/Dispatcher/Builder.pm
lib/Path/Dispatcher/Cookbook.pod
-lib/Path/Dispatcher/Declarative.pm
lib/Path/Dispatcher/Dispatch.pm
lib/Path/Dispatcher/Match.pm
lib/Path/Dispatcher/Path.pm
lib/Path/Dispatcher/Role/Rules.pm
lib/Path/Dispatcher/Rule.pm
+lib/Path/Dispatcher/Rule/Alternation.pm
lib/Path/Dispatcher/Rule/Always.pm
lib/Path/Dispatcher/Rule/Chain.pm
lib/Path/Dispatcher/Rule/CodeRef.pm
lib/Path/Dispatcher/Rule/Dispatch.pm
lib/Path/Dispatcher/Rule/Empty.pm
+lib/Path/Dispatcher/Rule/Enum.pm
lib/Path/Dispatcher/Rule/Eq.pm
lib/Path/Dispatcher/Rule/Intersection.pm
lib/Path/Dispatcher/Rule/Metadata.pm
lib/Path/Dispatcher/Rule/Regex.pm
+lib/Path/Dispatcher/Rule/Sequence.pm
lib/Path/Dispatcher/Rule/Tokens.pm
lib/Path/Dispatcher/Rule/Under.pm
Makefile.PL
MANIFEST This list of files
+META.yml
t/000-compile.t
t/001-api.t
t/002-rule.t
@@ -44,27 +46,13 @@
t/013-tokens.t
t/014-tokens-prefix.t
t/015-regex-prefix.t
-t/016-more-under.t
t/017-intersection.t
t/018-metadata.t
t/019-intersection-metadata.t
-t/020-chain.t
-t/021-declarative-defaults.t
t/022-numbers-undef.t
-t/100-declarative.t
-t/101-subclass.t
-t/102-abort.t
-t/103-input.t
-t/104-config.t
-t/105-empty.t
-t/106-metadata.t
-t/200-under-next_rule.t
-t/300-complete-simple.t
-t/301-complete-complex.t
-t/302-complete-delimiter.t
-t/303-complete-alternation.t
-t/800-cb-slash-path-delimiter.t
-t/801-cb-chaining.t
+t/023-alternation.t
+t/024-sequence.t
+t/025-sequence-custom-rule.t
t/900-use-path-dispatcher.t
t/901-return-values.t
t/902-coderef.t
Added: branches/upstream/libpath-dispatcher-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/META.yml?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/META.yml (added)
+++ branches/upstream/libpath-dispatcher-perl/current/META.yml Mon Mar 29 01:42:57 2010
@@ -1,0 +1,27 @@
+---
+abstract: 'flexible and extensible dispatch'
+author:
+ - 'Shawn M Moore, C<< <sartak at bestpractical.com> >>'
+build_requires:
+ ExtUtils::MakeMaker: 6.42
+ Test::Exception: 0
+configure_requires:
+ ExtUtils::MakeMaker: 6.42
+distribution_type: module
+generated_by: 'Module::Install version 0.91'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Path-Dispatcher
+no_index:
+ directory:
+ - inc
+ - t
+requires:
+ Any::Moose: 0
+ perl: 5.8.1
+resources:
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/bestpractical/path-dispatcher
+version: 0.15
Modified: branches/upstream/libpath-dispatcher-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/Makefile.PL?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/Makefile.PL (original)
+++ branches/upstream/libpath-dispatcher-perl/current/Makefile.PL Mon Mar 29 01:42:57 2010
@@ -5,7 +5,6 @@
repository 'http://github.com/bestpractical/path-dispatcher';
requires 'Any::Moose';
-requires 'Sub::Exporter';
build_requires 'Test::Exception';
Modified: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher.pm?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher.pm (original)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher.pm Mon Mar 29 01:42:57 2010
@@ -2,7 +2,7 @@
use Any::Moose;
use 5.008001;
-our $VERSION = '0.14';
+our $VERSION = '0.15';
use Path::Dispatcher::Rule;
use Path::Dispatcher::Dispatch;
@@ -27,14 +27,7 @@
sub dispatch {
my $self = shift;
- my $path = shift;
-
- # Automatically box paths
- unless (blessed($path) && $path->isa('Path::Dispatcher::Path')) {
- $path = $self->path_class->new(
- path => $path,
- );
- }
+ my $path = $self->_autobox_path(shift);
my $dispatch = $self->dispatch_class->new;
@@ -71,17 +64,23 @@
sub complete {
my $self = shift;
+ my $path = $self->_autobox_path(shift);
+
+ my %seen;
+ return grep { !$seen{$_}++ } map { $_->complete($path) } $self->rules;
+}
+
+sub _autobox_path {
+ my $self = shift;
my $path = shift;
- # Automatically box paths
unless (blessed($path) && $path->isa('Path::Dispatcher::Path')) {
$path = $self->path_class->new(
path => $path,
);
}
- my %seen;
- return grep { !$seen{$_}++ } map { $_->complete($path) } $self->rules;
+ return $path;
}
# We don't export anything, so if they request something, then try to error
@@ -114,7 +113,7 @@
$dispatcher->add_rule(
Path::Dispatcher::Rule::Regex->new(
regex => qr{^/(foo)/},
- block => sub { warn $1; }, # foo
+ block => sub { warn $1; },
)
);
@@ -218,7 +217,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright 2008-2009 Best Practical Solutions.
+Copyright 2008-2010 Best Practical Solutions.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule.pm?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule.pm (original)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule.pm Mon Mar 29 01:42:57 2010
@@ -139,15 +139,18 @@
no Any::Moose;
# don't require others to load our subclasses explicitly
+require Path::Dispatcher::Rule::Alternation;
require Path::Dispatcher::Rule::Always;
require Path::Dispatcher::Rule::Chain;
require Path::Dispatcher::Rule::CodeRef;
require Path::Dispatcher::Rule::Dispatch;
require Path::Dispatcher::Rule::Empty;
+require Path::Dispatcher::Rule::Enum;
require Path::Dispatcher::Rule::Eq;
require Path::Dispatcher::Rule::Intersection;
require Path::Dispatcher::Rule::Metadata;
require Path::Dispatcher::Rule::Regex;
+require Path::Dispatcher::Rule::Sequence;
require Path::Dispatcher::Rule::Tokens;
require Path::Dispatcher::Rule::Under;
Added: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Alternation.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Alternation.pm?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Alternation.pm (added)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Alternation.pm Mon Mar 29 01:42:57 2010
@@ -1,0 +1,47 @@
+package Path::Dispatcher::Rule::Alternation;
+use Any::Moose;
+extends 'Path::Dispatcher::Rule';
+
+with 'Path::Dispatcher::Role::Rules';
+
+sub _match {
+ my $self = shift;
+ my $path = shift;
+
+ my @rules = $self->rules;
+ return 0 if @rules == 0;
+
+ for my $rule (@rules) {
+ return 1 if $rule->match($path);
+ }
+
+ return 0;
+}
+
+sub complete {
+ my $self = shift;
+
+ return map { $_->complete(@_) } $self->rules;
+}
+
+__PACKAGE__->meta->make_immutable;
+no Any::Moose;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Path::Dispatcher::Rule::Alternation - any rule must match
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 ATTRIBUTES
+
+=head2 rules
+
+=cut
+
Modified: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/CodeRef.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/CodeRef.pm?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/CodeRef.pm (original)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/CodeRef.pm Mon Mar 29 01:42:57 2010
@@ -53,8 +53,10 @@
Rules of this class can match arbitrarily complex values. This should be used
only when there is no other recourse, because there's no way we can inspect
-how things match. Create a custom subclass of L<Path::Dispatcher::Rule> if
-necessary!
+how things match.
+
+You're much better off creating a custom subclass of L<Path::Dispatcher::Rule>
+if at all possible.
=head1 ATTRIBUTES
Modified: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Dispatch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Dispatch.pm?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Dispatch.pm (original)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Dispatch.pm Mon Mar 29 01:42:57 2010
@@ -6,7 +6,7 @@
is => 'rw',
isa => 'Path::Dispatcher',
required => 1,
- handles => ['rules'],
+ handles => ['rules', 'complete'],
);
sub match {
Added: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Enum.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Enum.pm?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Enum.pm (added)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Enum.pm Mon Mar 29 01:42:57 2010
@@ -1,0 +1,111 @@
+package Path::Dispatcher::Rule::Enum;
+use Any::Moose;
+extends 'Path::Dispatcher::Rule';
+
+has enum => (
+ is => 'rw',
+ isa => 'ArrayRef[Str]',
+ required => 1,
+);
+
+has case_sensitive => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 1,
+);
+
+sub _match {
+ my $self = shift;
+ my $path = shift;
+
+ if ($self->case_sensitive) {
+ for my $value (@{ $self->enum }) {
+ return 1 if $path->path eq $value;
+ }
+ }
+ else {
+ for my $value (@{ $self->enum }) {
+ return 1 if lc($path->path) eq lc($value);
+ }
+ }
+}
+
+sub _prefix_match {
+ my $self = shift;
+ my $path = shift;
+
+ my $truncated = substr($path->path, 0, length($self->string));
+
+ if ($self->case_sensitive) {
+ for my $value (@{ $self->enum }) {
+ return (1, substr($path->path, length($self->string)))
+ if $truncated eq $value;
+ }
+ }
+ else {
+ for my $value (@{ $self->enum }) {
+ return (1, substr($path->path, length($self->string)))
+ if lc($truncated) eq lc($value);
+ }
+ }
+}
+
+sub complete {
+ my $self = shift;
+ my $path = shift->path;
+ my @completions;
+
+ # by convention, complete does include the path itself if it
+ # is a complete match
+ my @enum = grep { length($path) < length($_) } @{ $self->enum };
+
+ if ($self->case_sensitive) {
+ for my $value (@enum) {
+ my $partial = substr($value, 0, length($path));
+ push @completions, $value if $partial eq $path;
+ }
+ }
+ else {
+ for my $value (@enum) {
+ my $partial = substr($value, 0, length($path));
+ push @completions, $value if lc($partial) eq lc($path);
+ }
+ }
+
+ return @completions;
+}
+
+sub readable_attributes { q{"} . shift->string . q{"} }
+
+__PACKAGE__->meta->make_immutable;
+no Any::Moose;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Path::Dispatcher::Rule::Enum - one of a list of strings must match
+
+=head1 SYNOPSIS
+
+ my $rule = Path::Dispatcher::Rule::Enum->new(
+ enum => [qw(perl ruby python php)],
+ block => sub { warn "$1 rules!" },
+ );
+
+=head1 DESCRIPTION
+
+Rules of this class check whether the path matches any of its
+L</enum> strings.
+
+=head1 ATTRIBUTES
+
+=head2 enum
+
+=head2 case_sensitive
+
+=cut
+
+
Modified: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Eq.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Eq.pm?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Eq.pm (original)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Eq.pm Mon Mar 29 01:42:57 2010
@@ -8,11 +8,22 @@
required => 1,
);
+has case_sensitive => (
+ is => 'rw',
+ isa => 'Bool',
+ default => 1,
+);
+
sub _match {
my $self = shift;
my $path = shift;
- return $path->path eq $self->string;
+ if ($self->case_sensitive) {
+ return $path->path eq $self->string;
+ }
+ else {
+ return lc($path->path) eq lc($self->string);
+ }
}
sub _prefix_match {
@@ -20,7 +31,13 @@
my $path = shift;
my $truncated = substr($path->path, 0, length($self->string));
- return 0 unless $truncated eq $self->string;
+
+ if ($self->case_sensitive) {
+ return 0 unless $truncated eq $self->string;
+ }
+ else {
+ return 0 unless lc($truncated) eq lc($self->string);
+ }
return (1, substr($path->path, length($self->string)));
}
@@ -30,7 +47,18 @@
my $path = shift->path;
my $completed = $self->string;
- return unless substr($completed, 0, length($path)) eq $path;
+ # by convention, complete does include the path itself if it
+ # is a complete match
+ return if length($path) >= length($completed);
+
+ my $partial = substr($completed, 0, length($path));
+ if ($self->case_sensitive) {
+ return unless $partial eq $path;
+ }
+ else {
+ return unless lc($partial) eq lc($path);
+ }
+
return $completed;
}
@@ -51,7 +79,7 @@
my $rule = Path::Dispatcher::Rule::Eq->new(
string => 'comment',
- block => sub { display_comment($2) },
+ block => sub { display_comment($1) },
);
=head1 DESCRIPTION
Modified: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Intersection.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Intersection.pm?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Intersection.pm (original)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Intersection.pm Mon Mar 29 01:42:57 2010
@@ -8,7 +8,10 @@
my $self = shift;
my $path = shift;
- for my $rule ($self->rules) {
+ my @rules = $self->rules;
+ return 0 if @rules == 0;
+
+ for my $rule (@rules) {
return 0 unless $rule->match($path);
}
Added: branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Sequence.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Sequence.pm?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Sequence.pm (added)
+++ branches/upstream/libpath-dispatcher-perl/current/lib/Path/Dispatcher/Rule/Sequence.pm Mon Mar 29 01:42:57 2010
@@ -1,0 +1,106 @@
+package Path::Dispatcher::Rule::Sequence;
+use Any::Moose;
+
+extends 'Path::Dispatcher::Rule';
+with 'Path::Dispatcher::Role::Rules';
+
+has delimiter => (
+ is => 'rw',
+ isa => 'Str',
+ default => ' ',
+);
+
+sub _match_as_far_as_possible {
+ my $self = shift;
+ my $path = shift;
+
+ my @tokens = $self->tokenize($path->path);
+ my @rules = $self->rules;
+ my @matched;
+
+ while (@tokens && @rules) {
+ my $rule = $rules[0];
+ my $token = $tokens[0];
+
+ last unless $rule->match($path->clone_path($token));
+
+ push @matched, $token;
+ shift @rules;
+ shift @tokens;
+ }
+
+ return (\@matched, \@tokens, \@rules);
+}
+
+sub _match {
+ my $self = shift;
+ my $path = shift;
+
+ my ($matched, $tokens, $rules) = $self->_match_as_far_as_possible($path);
+
+ return if @$rules; # didn't provide everything necessary
+ return if @$tokens && !$self->prefix; # had tokens left over
+
+ my $leftover = $self->untokenize(@$tokens);
+ return $matched, $leftover;
+}
+
+sub complete {
+ my $self = shift;
+ my $path = shift;
+
+ my ($matched, $tokens, $rules) = $self->_match_as_far_as_possible($path);
+ return if @$tokens > 1; # had tokens leftover
+ return if !@$rules; # consumed all rules
+
+ my $rule = shift @$rules;
+ my $token = @$tokens ? shift @$tokens : '';
+
+ return map { $self->untokenize(@$matched, $_) }
+ $rule->complete($path->clone_path($token));
+}
+
+sub tokenize {
+ my $self = shift;
+ my $path = shift;
+ return grep { length } split $self->delimiter, $path;
+}
+
+sub untokenize {
+ my $self = shift;
+ my @tokens = @_;
+ return join $self->delimiter,
+ grep { length }
+ map { split $self->delimiter, $_ }
+ @tokens;
+}
+
+__PACKAGE__->meta->make_immutable;
+no Any::Moose;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Path::Dispatcher::Rule::Sequence - a sequence of rules
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This is basically a more robust and flexible version of
+L<Path::Dispatcher::Rule::Tokens>.
+
+Instead of a mish-mash of strings, regexes, and array references,
+a Sequence rule has just a list of other rules.
+
+=head1 ATTRIBUTES
+
+=head2 rules
+
+=head2 delimiter
+
+=cut
+
Modified: branches/upstream/libpath-dispatcher-perl/current/t/017-intersection.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/t/017-intersection.t?rev=54991&op=diff
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/t/017-intersection.t (original)
+++ branches/upstream/libpath-dispatcher-perl/current/t/017-intersection.t Mon Mar 29 01:42:57 2010
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 4;
use Path::Dispatcher;
my @calls;
@@ -33,3 +33,16 @@
$dispatcher->run(" foo ");
is_deeply([splice @calls], [], "each subrule of the intersection must match");
+# test empty intersection
+$dispatcher = Path::Dispatcher->new(
+ rules => [
+ Path::Dispatcher::Rule::Intersection->new(
+ rules => [ ],
+ block => sub { push @calls, 'intersection' },
+ ),
+ ],
+);
+
+$dispatcher->run("foo");
+is_deeply([splice @calls], [], "no subrules means no match");
+
Added: branches/upstream/libpath-dispatcher-perl/current/t/023-alternation.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/t/023-alternation.t?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/t/023-alternation.t (added)
+++ branches/upstream/libpath-dispatcher-perl/current/t/023-alternation.t Mon Mar 29 01:42:57 2010
@@ -1,0 +1,58 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 13;
+use Path::Dispatcher;
+
+my @calls;
+
+my $dispatcher = Path::Dispatcher->new(
+ rules => [
+ Path::Dispatcher::Rule::Alternation->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'foo',
+ block => sub { push @calls, 'foo' },
+ ),
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'bar',
+ block => sub { push @calls, 'bar' },
+ ),
+ ],
+ block => sub { push @calls, 'alternation' },
+ ),
+ ],
+);
+
+$dispatcher->run("foo");
+is_deeply([splice @calls], ['alternation'], "the alternation matched; doesn't automatically run the subrules");
+
+$dispatcher->run("bar");
+is_deeply([splice @calls], ['alternation'], "the alternation matched; doesn't automatically run the subrules");
+
+$dispatcher->run("baz");
+is_deeply([splice @calls], [], "each subrule of the intersection must match");
+
+is_deeply([$dispatcher->complete("")], ["foo", "bar"]);
+is_deeply([$dispatcher->complete("f")], ["foo"]);
+is_deeply([$dispatcher->complete("b")], ["bar"]);
+is_deeply([$dispatcher->complete("fo")], ["foo"]);
+is_deeply([$dispatcher->complete("ba")], ["bar"]);
+is_deeply([$dispatcher->complete("foo")], []);
+is_deeply([$dispatcher->complete("bar")], []);
+is_deeply([$dispatcher->complete("fx")], []);
+is_deeply([$dispatcher->complete("baz")], []);
+
+# test empty alternation
+$dispatcher = Path::Dispatcher->new(
+ rules => [
+ Path::Dispatcher::Rule::Alternation->new(
+ rules => [ ],
+ block => sub { push @calls, 'alternation' },
+ ),
+ ],
+);
+
+$dispatcher->run("foo");
+is_deeply([splice @calls], [], "no subrules means no match");
+
Added: branches/upstream/libpath-dispatcher-perl/current/t/024-sequence.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/t/024-sequence.t?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/t/024-sequence.t (added)
+++ branches/upstream/libpath-dispatcher-perl/current/t/024-sequence.t Mon Mar 29 01:42:57 2010
@@ -1,0 +1,129 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 10;
+use Path::Dispatcher;
+
+my @calls;
+
+my $dispatcher = Path::Dispatcher->new;
+$dispatcher->add_rule(
+ Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'foo',
+ ),
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'bar',
+ ),
+ ],
+ block => sub { push @calls, [$1, $2, $3] },
+ ),
+);
+
+$dispatcher->run('foo bar');
+is_deeply([splice @calls], [ ['foo', 'bar', undef] ], "correctly populated number vars from [str, str] token rule");
+
+$dispatcher->add_rule(
+ Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'foo',
+ ),
+ Path::Dispatcher::Rule::Regex->new(
+ regex => qr/bar/,
+ ),
+ ],
+ block => sub { push @calls, [$1, $2, $3] },
+ ),
+);
+
+$dispatcher->run('foo bar');
+is_deeply([splice @calls], [ ['foo', 'bar', undef] ], "ran the first [str, str] rule");
+
+$dispatcher->run('foo barbaz');
+is_deeply([splice @calls], [ ['foo', 'barbaz', undef] ], "ran the second [str, regex] rule");
+
+$dispatcher->run('foo bar baz');
+is_deeply([splice @calls], [ ], "no matches");
+
+$dispatcher->add_rule(
+ Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Alternation->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'Bat',
+ ),
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'Super',
+ ),
+ ],
+ ),
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'Man',
+ ),
+ ],
+ block => sub { push @calls, [$1, $2, $3] },
+ ),
+);
+
+$dispatcher->run('Super Man');
+is_deeply([splice @calls], [ ['Super', 'Man', undef] ], "ran the [ [Str,Str], Str ] rule");
+
+$dispatcher->run('Bat Man');
+is_deeply([splice @calls], [ ['Bat', 'Man', undef] ], "ran the [ [Str,Str], Str ] rule");
+
+$dispatcher->run('Aqua Man');
+is_deeply([splice @calls], [ ], "no match");
+
+$dispatcher->add_rule(
+ Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Alternation->new(
+ rules => [
+ Path::Dispatcher::Rule::Alternation->new(
+ rules => [
+ Path::Dispatcher::Rule::Alternation->new(
+ rules => [
+ Path::Dispatcher::Rule::Regex->new(
+ regex => qr/Deep/,
+ ),
+ ],
+ ),
+ ],
+ ),
+ ],
+ ),
+ Path::Dispatcher::Rule::Eq->new(
+ string => "Man",
+ ),
+ ],
+ block => sub { push @calls, [$1, $2, $3] },
+ ),
+);
+
+$dispatcher->run('Deep Man');
+is_deeply([splice @calls], [ ['Deep', 'Man', undef] ], "alternations can be arbitrarily deep");
+
+$dispatcher->run('Not Appearing in this Dispatcher Man');
+is_deeply([splice @calls], [ ], "no match");
+
+my $rule = Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'path',
+ case_sensitive => 0,
+ ),
+ Path::Dispatcher::Rule::Eq->new(
+ string => 'dispatcher',
+ case_sensitive => 0,
+ ),
+ ],
+ prefix => 1,
+ delimiter => '::',
+);
+
+my $match = $rule->match(Path::Dispatcher::Path->new('Path::Dispatcher::Rule::Tokens'));
+is($match->leftover, 'Rule::Tokens');
+
Added: branches/upstream/libpath-dispatcher-perl/current/t/025-sequence-custom-rule.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-dispatcher-perl/current/t/025-sequence-custom-rule.t?rev=54991&op=file
==============================================================================
--- branches/upstream/libpath-dispatcher-perl/current/t/025-sequence-custom-rule.t (added)
+++ branches/upstream/libpath-dispatcher-perl/current/t/025-sequence-custom-rule.t Mon Mar 29 01:42:57 2010
@@ -1,0 +1,124 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 47;
+use Path::Dispatcher;
+
+my @calls;
+
+do {
+ package MyApp::Dispatcher::Rule::Language;
+ use Any::Moose;
+ extends 'Path::Dispatcher::Rule::Enum';
+
+ has '+enum' => (
+ default => sub { [qw/ruby perl php python/] },
+ );
+};
+
+my $dispatcher = Path::Dispatcher->new(
+ rules => [
+ Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(string => 'use'),
+ MyApp::Dispatcher::Rule::Language->new,
+ ],
+ block => sub { push @calls, [$1, $2, $3] },
+ ),
+ ],
+);
+
+$dispatcher->run("use perl");
+is_deeply([splice @calls], [["use", "perl", undef]]);
+
+$dispatcher->run("use python");
+is_deeply([splice @calls], [["use", "python", undef]]);
+
+$dispatcher->run("use php");
+is_deeply([splice @calls], [["use", "php", undef]]);
+
+$dispatcher->run("use ruby");
+is_deeply([splice @calls], [["use", "ruby", undef]]);
+
+$dispatcher->run("use c++");
+is_deeply([splice @calls], []);
+
+is_deeply([$dispatcher->complete("u")], ["use"]);
+is_deeply([$dispatcher->complete("use")], ["use ruby", "use perl", "use php", "use python"]);
+is_deeply([$dispatcher->complete("use ")], ["use ruby", "use perl", "use php", "use python"]);
+is_deeply([$dispatcher->complete("use r")], ["use ruby"]);
+is_deeply([$dispatcher->complete("use p")], ["use perl", "use php", "use python"]);
+is_deeply([$dispatcher->complete("use pe")], ["use perl"]);
+is_deeply([$dispatcher->complete("use ph")], ["use php"]);
+is_deeply([$dispatcher->complete("use py")], ["use python"]);
+is_deeply([$dispatcher->complete("use px")], []);
+is_deeply([$dispatcher->complete("use x")], []);
+
+
+$dispatcher = Path::Dispatcher->new(
+ rules => [
+ Path::Dispatcher::Rule::Sequence->new(
+ rules => [
+ Path::Dispatcher::Rule::Eq->new(string => 'use'),
+ MyApp::Dispatcher::Rule::Language->new,
+ Path::Dispatcher::Rule::Eq->new(string => 'please'),
+ ],
+ block => sub { push @calls, [$1, $2, $3, $4] },
+ ),
+ ],
+);
+
+$dispatcher->run("use perl");
+is_deeply([splice @calls], []);
+
+$dispatcher->run("use perl please");
+is_deeply([splice @calls], [["use", "perl", "please", undef]]);
+
+$dispatcher->run("use python");
+is_deeply([splice @calls], []);
+
+$dispatcher->run("use python please");
+is_deeply([splice @calls], [["use", "python", "please", undef]]);
+
+$dispatcher->run("use php");
+is_deeply([splice @calls], []);
+
+$dispatcher->run("use php please");
+is_deeply([splice @calls], [["use", "php", "please", undef]]);
+
+$dispatcher->run("use ruby");
+is_deeply([splice @calls], []);
+
+$dispatcher->run("use ruby please");
+is_deeply([splice @calls], [["use", "ruby", "please", undef]]);
+
+$dispatcher->run("use c++");
+is_deeply([splice @calls], []);
+
+$dispatcher->run("use c++ please");
+is_deeply([splice @calls], []);
+
+is_deeply([$dispatcher->complete("u")], ["use"]);
+is_deeply([$dispatcher->complete("use")], ["use ruby", "use perl", "use php", "use python"]);
+is_deeply([$dispatcher->complete("use ")], ["use ruby", "use perl", "use php", "use python"]);
+is_deeply([$dispatcher->complete("use r")], ["use ruby"]);
+is_deeply([$dispatcher->complete("use p")], ["use perl", "use php", "use python"]);
+is_deeply([$dispatcher->complete("use pe")], ["use perl"]);
+is_deeply([$dispatcher->complete("use ph")], ["use php"]);
+is_deeply([$dispatcher->complete("use py")], ["use python"]);
+is_deeply([$dispatcher->complete("use px")], []);
+is_deeply([$dispatcher->complete("use x")], []);
+
+is_deeply([$dispatcher->complete("use ruby")], ["use ruby please"]);
+is_deeply([$dispatcher->complete("use ruby ")], ["use ruby please"]);
+is_deeply([$dispatcher->complete("use ruby pl")], ["use ruby please"]);
+is_deeply([$dispatcher->complete("use ruby pleas")], ["use ruby please"]);
+is_deeply([$dispatcher->complete("use ruby please")], []);
+is_deeply([$dispatcher->complete("use ruby plx")], []);
+
+is_deeply([$dispatcher->complete("use perl")], ["use perl please"]);
+is_deeply([$dispatcher->complete("use perl ")], ["use perl please"]);
+is_deeply([$dispatcher->complete("use perl pl")], ["use perl please"]);
+is_deeply([$dispatcher->complete("use perl pleas")], ["use perl please"]);
+is_deeply([$dispatcher->complete("use perl please")], []);
+is_deeply([$dispatcher->complete("use perl plx")], []);
More information about the Pkg-perl-cvs-commits
mailing list