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