[Bps-public-commit] Path-Dispatcher branch, master, updated. 6d7b67c5d485fcdb62090b4b0333a90aa0e2ef2d
sartak at bestpractical.com
sartak at bestpractical.com
Tue Mar 16 09:21:10 EDT 2010
The branch, master has been updated
via 6d7b67c5d485fcdb62090b4b0333a90aa0e2ef2d (commit)
from 663b35374ce5fe45786b504af97e134125d58d04 (commit)
Summary of changes:
lib/Path/Dispatcher/Builder.pm | 260 ------------------------------------
lib/Path/Dispatcher/Declarative.pm | 197 ---------------------------
t/016-more-under.t | 52 -------
t/020-chain.t | 162 ----------------------
t/021-declarative-defaults.t | 25 ----
t/100-declarative.t | 83 ------------
t/101-subclass.t | 42 ------
t/102-abort.t | 58 --------
t/103-input.t | 57 --------
t/104-config.t | 31 -----
t/105-empty.t | 22 ---
t/106-metadata.t | 52 -------
t/200-under-next_rule.t | 32 -----
t/300-complete-simple.t | 53 --------
t/301-complete-complex.t | 73 ----------
t/302-complete-delimiter.t | 57 --------
t/303-complete-alternation.t | 59 --------
t/304-complete-enum.t | 59 --------
t/800-cb-slash-path-delimiter.t | 32 -----
t/801-cb-chaining.t | 34 -----
20 files changed, 0 insertions(+), 1440 deletions(-)
delete mode 100644 lib/Path/Dispatcher/Builder.pm
delete mode 100644 lib/Path/Dispatcher/Declarative.pm
delete mode 100644 t/016-more-under.t
delete mode 100644 t/020-chain.t
delete mode 100644 t/021-declarative-defaults.t
delete mode 100644 t/100-declarative.t
delete mode 100644 t/101-subclass.t
delete mode 100644 t/102-abort.t
delete mode 100644 t/103-input.t
delete mode 100644 t/104-config.t
delete mode 100644 t/105-empty.t
delete mode 100644 t/106-metadata.t
delete mode 100644 t/200-under-next_rule.t
delete mode 100644 t/300-complete-simple.t
delete mode 100644 t/301-complete-complex.t
delete mode 100644 t/302-complete-delimiter.t
delete mode 100644 t/303-complete-alternation.t
delete mode 100644 t/304-complete-enum.t
delete mode 100644 t/800-cb-slash-path-delimiter.t
delete mode 100644 t/801-cb-chaining.t
- Log -----------------------------------------------------------------
commit 6d7b67c5d485fcdb62090b4b0333a90aa0e2ef2d
Author: Shawn M Moore <sartak at bestpractical.com>
Date: Tue Mar 16 09:19:14 2010 -0400
Remove Path::Dispatcher::Declarative
See http://github.com/bestpractical/path-dispatcher-declarative
diff --git a/lib/Path/Dispatcher/Builder.pm b/lib/Path/Dispatcher/Builder.pm
deleted file mode 100644
index 3ffdab3..0000000
--- a/lib/Path/Dispatcher/Builder.pm
+++ /dev/null
@@ -1,260 +0,0 @@
-package Path::Dispatcher::Builder;
-use Any::Moose;
-
-our $OUTERMOST_DISPATCHER;
-our $UNDER_RULE;
-
-has dispatcher => (
- is => 'ro',
- isa => 'Path::Dispatcher',
- lazy => 1,
- default => sub { return Path::Dispatcher->new },
-);
-
-has case_sensitive_tokens => (
- is => 'rw',
- isa => 'Bool',
- default => 1,
-);
-
-has token_delimiter => (
- is => 'rw',
- isa => 'Str',
- default => ' ',
-);
-
-sub next_rule () {
- die "Path::Dispatcher next rule\n";
-}
-
-sub last_rule () {
- die "Path::Dispatcher abort\n";
-}
-
-sub dispatch {
- my $self = shift;
-
- local $OUTERMOST_DISPATCHER = $self->dispatcher
- if !$OUTERMOST_DISPATCHER;
-
- $OUTERMOST_DISPATCHER->dispatch(@_);
-}
-
-sub run {
- my $self = shift;
-
- local $OUTERMOST_DISPATCHER = $self->dispatcher
- if !$OUTERMOST_DISPATCHER;
-
- $OUTERMOST_DISPATCHER->run(@_);
-}
-
-sub complete {
- my $self = shift;
- my $dispatcher = shift;
-
- local $OUTERMOST_DISPATCHER = $self->dispatcher
- if !$OUTERMOST_DISPATCHER;
-
- $OUTERMOST_DISPATCHER->complete(@_);
-}
-
-sub rewrite {
- my $self = shift;
- my ($from, $to) = @_;
- my $rewrite = sub {
- local $OUTERMOST_DISPATCHER = $self->dispatcher
- if !$OUTERMOST_DISPATCHER;
- my $path = ref($to) eq 'CODE' ? $to->() : $to;
- $OUTERMOST_DISPATCHER->run($path, @_);
- };
- $self->_add_rule($from, $rewrite);
-}
-
-sub on {
- my $self = shift;
- $self->_add_rule(@_);
-}
-
-sub enum {
- my $self = shift;
- Path::Dispatcher::Rule::Enum->new(
- enum => [@_],
- );
-}
-
-sub then {
- my $self = shift;
- my $block = shift;
- my $rule = Path::Dispatcher::Rule::Always->new(
- block => sub {
- $block->(@_);
- next_rule;
- },
- );
- $self->_add_rule($rule);
-}
-
-sub chain {
- my $self = shift;
- my $block = shift;
- my $rule = Path::Dispatcher::Rule::Chain->new(
- block => $block,
- );
- $self->_add_rule($rule);
-}
-
-sub under {
- my $self = shift;
- my ($matcher, $rules) = @_;
-
- my $predicate = $self->_create_rule($matcher);
- $predicate->prefix(1);
-
- my $under = Path::Dispatcher::Rule::Under->new(
- predicate => $predicate,
- );
-
- $self->_add_rule($under, @_);
-
- do {
- local $UNDER_RULE = $under;
- $rules->();
- };
-}
-
-sub redispatch_to {
- my $self = shift;
- my $dispatcher = shift;
-
- # assume it's a declarative dispatcher
- if (!ref($dispatcher)) {
- $dispatcher = $dispatcher->dispatcher;
- }
-
- my $redispatch = Path::Dispatcher::Rule::Dispatch->new(
- dispatcher => $dispatcher,
- );
-
- $self->_add_rule($redispatch);
-}
-
-sub rule_creators {
- return {
- ARRAY => sub {
- my ($self, $tokens, $block) = @_;
-
- Path::Dispatcher::Rule::Tokens->new(
- tokens => $tokens,
- delimiter => $self->token_delimiter,
- case_sensitive => $self->case_sensitive_tokens,
- $block ? (block => $block) : (),
- ),
- },
- HASH => sub {
- my ($self, $metadata_matchers, $block) = @_;
-
- if (keys %$metadata_matchers == 1) {
- my ($field) = keys %$metadata_matchers;
- my ($value) = values %$metadata_matchers;
- my $matcher = $self->_create_rule($value);
-
- return Path::Dispatcher::Rule::Metadata->new(
- field => $field,
- matcher => $matcher,
- $block ? (block => $block) : (),
- );
- }
-
- die "Doesn't support multiple metadata rules yet";
- },
- CODE => sub {
- my ($self, $matcher, $block) = @_;
- Path::Dispatcher::Rule::CodeRef->new(
- matcher => $matcher,
- $block ? (block => $block) : (),
- ),
- },
- Regexp => sub {
- my ($self, $regex, $block) = @_;
- Path::Dispatcher::Rule::Regex->new(
- regex => $regex,
- $block ? (block => $block) : (),
- ),
- },
- empty => sub {
- my ($self, $undef, $block) = @_;
- Path::Dispatcher::Rule::Empty->new(
- $block ? (block => $block) : (),
- ),
- },
- };
-}
-
-sub _create_rule {
- my ($self, $matcher, $block) = @_;
-
- my $rule_creator;
-
- if ($matcher eq '') {
- $rule_creator = $self->rule_creators->{empty};
- }
- elsif (!ref($matcher)) {
- $rule_creator = $self->rule_creators->{ARRAY};
- $matcher = [$matcher];
- }
- else {
- $rule_creator = $self->rule_creators->{ ref $matcher };
- }
-
- $rule_creator or die "I don't know how to create a rule for type $matcher";
-
- return $rule_creator->($self, $matcher, $block);
-}
-
-sub _add_rule {
- my $self = shift;
- my $rule;
-
- if (blessed($_[0]) && $_[0]->isa('Path::Dispatcher::Rule')) {
- $rule = shift;
- }
- else {
- my ($matcher, $block) = splice @_, 0, 2;
- $rule = $self->_create_rule($matcher, $block);
- }
-
- # FIXME: broken since move from ::Declarative
- # XXX: caller level should be closer to $Test::Builder::Level
-# my (undef, $file, $line) = caller(1);
- my (undef, $file, $line) = caller(2);
- my $rule_name = "$file:$line";
-
- if (!defined(wantarray)) {
- if ($UNDER_RULE) {
- $UNDER_RULE->add_rule($rule);
-
- my $full_name = $UNDER_RULE->has_name
- ? "(" . $UNDER_RULE->name . " - rule $rule_name)"
- : "(anonymous Under - rule $rule_name)";
-
- $rule->name($full_name) unless $rule->has_name;
- }
- else {
- $self->dispatcher->add_rule($rule);
- $rule->name("(" . $self->dispatcher->name . " - rule $rule_name)")
- unless $rule->has_name;
- }
- }
- else {
- $rule->name($rule_name)
- unless $rule->has_name;
- return $rule, @_;
- }
-}
-
-__PACKAGE__->meta->make_immutable;
-no Any::Moose;
-
-1;
-
diff --git a/lib/Path/Dispatcher/Declarative.pm b/lib/Path/Dispatcher/Declarative.pm
deleted file mode 100644
index bf01e94..0000000
--- a/lib/Path/Dispatcher/Declarative.pm
+++ /dev/null
@@ -1,197 +0,0 @@
-package Path::Dispatcher::Declarative;
-use strict;
-use warnings;
-use Path::Dispatcher;
-use Path::Dispatcher::Builder;
-use Sub::Exporter;
-
-use constant dispatcher_class => 'Path::Dispatcher';
-use constant builder_class => 'Path::Dispatcher::Builder';
-
-our $CALLER; # Sub::Exporter doesn't make this available
-
-my $exporter = Sub::Exporter::build_exporter({
- into_level => 1,
- groups => {
- default => \&build_sugar,
- },
-});
-
-sub import {
- my $self = shift;
- my $pkg = caller;
-
- my @args = grep { !/^-base$/i } @_;
-
- # just loading the class..
- return if @args == @_;
-
- do {
- no strict 'refs';
- push @{ $pkg . '::ISA' }, $self;
- };
-
- local $CALLER = $pkg;
-
- $exporter->($self, @args);
-}
-
-sub build_sugar {
- my ($class, $group, $arg) = @_;
-
- my $into = $CALLER;
-
- $class->populate_defaults($arg);
-
- my $dispatcher = $class->dispatcher_class->new(name => $into);
-
- my $builder = $class->builder_class->new(
- dispatcher => $dispatcher,
- %$arg,
- );
-
- return {
- dispatcher => sub { $builder->dispatcher },
- rewrite => sub { $builder->rewrite(@_) },
- on => sub { $builder->on(@_) },
- under => sub { $builder->under(@_) },
- redispatch_to => sub { $builder->redispatch_to(@_) },
- enum => sub { $builder->enum(@_) },
- next_rule => sub { $builder->next_rule(@_) },
- last_rule => sub { $builder->last_rule(@_) },
- complete => sub { $builder->complete(@_) },
-
- then => sub (&) { $builder->then(@_) },
- chain => sub (&) { $builder->chain(@_) },
-
- # NOTE on shift if $into: if caller is $into, then this function is
- # being used as sugar otherwise, it's probably a method call, so
- # discard the invocant
- dispatch => sub { shift if caller ne $into; $builder->dispatch(@_) },
- run => sub { shift if caller ne $into; $builder->run(@_) },
- };
-}
-
-sub populate_defaults {
- my $class = shift;
- my $arg = shift;
-
- for my $option ('token_delimiter', 'case_sensitive_tokens') {
- next if exists $arg->{$option};
- next unless $class->can($option);
-
- my $default = $class->$option;
- next unless defined $default; # use the builder's default
-
- $arg->{$option} = $class->$option;
- }
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-Path::Dispatcher::Declarative - sugary dispatcher
-
-=head1 SYNOPSIS
-
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on score => sub { show_score() };
-
- on ['wield', qr/^\w+$/] => sub { wield_weapon($2) };
-
- rewrite qr/^inv/ => "display inventory";
-
- under display => sub {
- on inventory => sub { show_inventory() };
- on score => sub { show_score() };
- };
-
- package Interpreter;
- MyApp::Dispatcher->run($input);
-
-=head1 DESCRIPTION
-
-L<Jifty::Dispatcher> rocks!
-
-=head1 KEYWORDS
-
-=head2 dispatcher -> Dispatcher
-
-Returns the L<Path::Dispatcher> object for this class; the object that the
-sugar is modifying. This is useful for adding custom rules through the regular
-API, and inspection.
-
-=head2 dispatch path -> Dispatch
-
-Invokes the dispatcher on the given path and returns a
-L<Path::Dispatcher::Dispatch> object. Acts as a keyword within the same
-package; otherwise as a method (since these declarative dispatchers are
-supposed to be used by other packages).
-
-=head2 run path, args
-
-Performs a dispatch then invokes the L<Path::Dispatcher::Dispatch/run> method
-on it.
-
-=head2 on path => sub {}
-
-Adds a rule to the dispatcher for the given path. The path may be:
-
-=over 4
-
-=item a string
-
-This is taken to mean a single token; creates an
-L<Path::Dispatcher::Rule::Tokens> rule.
-
-=item an array reference
-
-This is creates a L<Path::Dispatcher::Rule::Tokens> rule.
-
-=item a regular expression
-
-This is creates a L<Path::Dispatcher::Rule::Regex> rule.
-
-=item a code reference
-
-This is creates a L<Path::Dispatcher::Rule::CodeRef> rule.
-
-=back
-
-=head2 under path => sub {}
-
-Creates a L<Path::Dispatcher::Rule::Under> rule. The contents of the coderef
-should be nothing other L</on> and C<under> calls.
-
-=head2 then sub { }
-
-Creates a L<Path::Dispatcher::Rule::Always> rule that will continue on to the
-next rule via C<next_rule>
-
-The only argument is a coderef that processes normally (like L<on>).
-
-NOTE: You *can* avoid running a following rule by using C<last_rule>.
-
-An example:
-
- under show => sub {
- then {
- print "Displaying ";
- };
- on inventory => sub {
- print "inventory:\n";
- ...
- };
- on score => sub {
- print "score:\n";
- ...
- };
-
-=cut
-
diff --git a/t/016-more-under.t b/t/016-more-under.t
deleted file mode 100644
index 04763be..0000000
--- a/t/016-more-under.t
+++ /dev/null
@@ -1,52 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 8;
-
-my @calls;
-
-do {
- package Under::Where;
- use Path::Dispatcher::Declarative -base;
-
- under 'ticket' => sub {
- on 'create' => sub { push @calls, "ticket create" };
- on 'update' => sub { push @calls, "ticket update" };
- };
-
- under 'blog' => sub {
- under 'post' => sub {
- on 'create' => sub { push @calls, "create blog post" };
- on 'delete' => sub { push @calls, "delete blog post" };
- };
- under 'comment' => sub {
- on 'create' => sub { push @calls, "create blog comment" };
- on 'delete' => sub { push @calls, "delete blog comment" };
- };
- };
-};
-
-Under::Where->run('ticket create');
-is_deeply([splice @calls], ['ticket create']);
-
-Under::Where->run('ticket update');
-is_deeply([splice @calls], ['ticket update']);
-
-Under::Where->run('ticket foo');
-is_deeply([splice @calls], []);
-
-Under::Where->run('blog');
-is_deeply([splice @calls], []);
-
-Under::Where->run('blog post');
-is_deeply([splice @calls], []);
-
-Under::Where->run('blog post create');
-is_deeply([splice @calls], ['create blog post']);
-
-Under::Where->run('blog comment');
-is_deeply([splice @calls], []);
-
-Under::Where->run('blog comment create');
-is_deeply([splice @calls], ['create blog comment']);
-
diff --git a/t/020-chain.t b/t/020-chain.t
deleted file mode 100644
index 6cdb7a7..0000000
--- a/t/020-chain.t
+++ /dev/null
@@ -1,162 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 40;
-use Path::Dispatcher;
-
-my $predicate = Path::Dispatcher::Rule::Tokens->new(
- tokens => ['ticket'],
- prefix => 1,
-);
-
-my $chain = Path::Dispatcher::Rule::Chain->new;
-
-my $create = Path::Dispatcher::Rule::Tokens->new(
- tokens => ['create'],
-);
-
-my $update = Path::Dispatcher::Rule::Tokens->new(
- tokens => ['update'],
- prefix => 1,
-);
-
-my $under_always = Path::Dispatcher::Rule::Under->new(
- predicate => $predicate,
- rules => [Path::Dispatcher::Rule::Always->new, $create, $update],
-);
-
-my $under_chain = Path::Dispatcher::Rule::Under->new(
- predicate => $predicate,
- rules => [$chain, $create, $update],
-);
-
-my %tests = (
- "ticket" => {
- fail => 1,
- catchall => 1,
- always => 1,
- },
- "ticket create" => {},
- "ticket update" => {},
- " ticket update " => {
- name => "whitespace doesn't matter for token-based rules",
- },
- "ticket update foo" => {
- name => "'ticket update' rule is prefix",
- },
-
- "ticket create foo" => {
- fail => 1,
- catchall => 1,
- always => 1,
- name => "did not match 'ticket create foo' because it's not a suffix",
- },
- "comment create" => {
- fail => 1,
- name => "did not match 'comment create' because the prefix is ticket",
- },
- "ticket delete" => {
- fail => 1,
- catchall => 1,
- always => 1,
- name => "did not match 'ticket delete' because delete is not a suffix",
- },
-);
-
-sub run_tests {
- my $under = shift;
- my $is_always = shift;
-
- for my $path (keys %tests) {
- my $data = $tests{$path};
- my $name = $data->{name} || $path;
-
- my $match = $under->match(Path::Dispatcher::Path->new($path));
- $match = !$match if $data->{fail} && !($is_always && $data->{always}); # Always always matches
- ok($match, $name);
- }
-
- my $catchall = Path::Dispatcher::Rule::Regex->new(
- regex => qr/()/,
- );
-
- $under->add_rule($catchall);
-
- for my $path (keys %tests) {
- my $data = $tests{$path};
- my $name = $data->{name} || $path;
-
- my $match = $under->match(Path::Dispatcher::Path->new($path));
- $match = !$match if $data->{fail} && !$data->{catchall};
- ok($match, $name);
- }
-}
-
-run_tests $under_chain, 0;
-run_tests $under_always, 1;
-
-my @result;
-
-do {
- package ChainDispatch;
- use Path::Dispatcher::Declarative -base;
-
- under 'ticket' => sub {
- chain {
- push @result, "(ticket chain)";
- };
- on 'create' => sub { push @result, "ticket create" };
- chain {
- push @result, "(ticket chain just for update)";
- };
- on 'update' => sub { push @result, "ticket update" };
- };
-
- 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)";
- };
- };
- };
-};
-
-ChainDispatch->run('ticket create');
-is_deeply([splice @result], ['(ticket chain)', 'ticket create']);
-
-ChainDispatch->run('ticket update');
-is_deeply([splice @result], ['(ticket chain)', '(ticket chain just for update)', 'ticket update']);
-
-ChainDispatch->run('ticket foo');
-is_deeply([splice @result], []);
-
-ChainDispatch->run('blog');
-is_deeply([splice @result], []);
-
-ChainDispatch->run('blog post');
-is_deeply([splice @result], []);
-
-ChainDispatch->run('blog post create');
-is_deeply([splice @result], ['(blog chain)', '(after post)', 'create blog post']);
-
-ChainDispatch->run('blog comment');
-is_deeply([splice @result], []);
-
-ChainDispatch->run('blog comment create');
-is_deeply([splice @result], ['(blog chain)', '(before comment)', 'create blog comment']);
-
diff --git a/t/021-declarative-defaults.t b/t/021-declarative-defaults.t
deleted file mode 100644
index 2422f63..0000000
--- a/t/021-declarative-defaults.t
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 1;
-
-my @calls;
-do {
- package Web::Dispatcher;
- use base 'Path::Dispatcher::Declarative';
-
- use constant token_delimiter => '/';
-
-
- package My::Other::Dispatcher;
- # we can't use a package in the same file :/
- BEGIN { Web::Dispatcher->import('-base') };
-
- on ['foo', 'bar'] => sub {
- push @calls, '/foo/bar';
- };
-};
-
-My::Other::Dispatcher->run('/foo/bar');
-is_deeply([splice @calls], ['/foo/bar']);
-
diff --git a/t/100-declarative.t b/t/100-declarative.t
deleted file mode 100644
index f7868a1..0000000
--- a/t/100-declarative.t
+++ /dev/null
@@ -1,83 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 11;
-
-my @calls;
-
-do {
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on qr/(b)(ar)(.*)/ => sub {
- push @calls, [$1, $2, $3];
- };
-
- on ['token', 'matching'] => sub {
- push @calls, [$1, $2];
- };
-
- rewrite quux => 'bar';
- rewrite qr/^quux-(.*)/ => sub { "bar:$1" };
-
- on alpha => sub {
- push @calls, "alpha"
- };
-
- under alpha => sub {
- then {
- push @calls, "alpha (chain) ";
- };
- on one => sub {
- push @calls, "one";
- };
-
- then {
- push @calls, "(before two or three) ";
- };
- on two => sub {
- push @calls, "two";
- };
- on three => sub {
- push @calls, "three";
- };
- };
-};
-
-ok(MyApp::Dispatcher->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative sets up ISA");
-
-can_ok('MyApp::Dispatcher' => qw/dispatcher dispatch run/);
-MyApp::Dispatcher->run('foobarbaz');
-is_deeply([splice @calls], [
- [ 'b', 'ar', 'baz' ],
-]);
-
-MyApp::Dispatcher->run('quux');
-is_deeply([splice @calls], [
- [ 'b', 'ar', '' ],
-]);
-
-MyApp::Dispatcher->run('quux-hello');
-is_deeply([splice @calls], [
- [ 'b', 'ar', ':hello' ],
-]);
-
-MyApp::Dispatcher->run('token matching');
-is_deeply([splice @calls], [
- [ 'token', 'matching' ],
-]);
-
-MyApp::Dispatcher->run('Token Matching');
-is_deeply([splice @calls], [], "token matching is by default case sensitive");
-
-MyApp::Dispatcher->run('alpha');
-is_deeply([splice @calls], ['alpha']);
-
-MyApp::Dispatcher->run('alpha one');
-is_deeply([splice @calls], ['alpha (chain) ', 'one']);
-
-MyApp::Dispatcher->run('alpha two');
-is_deeply([splice @calls], ['alpha (chain) ', '(before two or three) ', 'two']);
-
-MyApp::Dispatcher->run('alpha three');
-is_deeply([splice @calls], ['alpha (chain) ', '(before two or three) ', 'three']);
diff --git a/t/101-subclass.t b/t/101-subclass.t
deleted file mode 100644
index 1af982f..0000000
--- a/t/101-subclass.t
+++ /dev/null
@@ -1,42 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 2;
-
-my @calls;
-
-do {
- package MyFramework::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on 'quit' => sub { push @calls, 'framework: quit' };
-
- package MyApp::Dispatcher;
- # this hack is here because "use" expects there to be a file for the module
- BEGIN { MyFramework::Dispatcher->import("-base") }
-
- on qr/.*/ => sub {
- push @calls, 'app: first .*';
- next_rule;
- };
-
- redispatch_to('MyFramework::Dispatcher');
-
- on qr/.*/ => sub {
- push @calls, 'app: second .*';
- next_rule;
- };
-};
-
-MyApp::Dispatcher->run("quit");
-is_deeply([splice @calls], [
- 'app: first .*',
- 'framework: quit',
-]);
-
-MyApp::Dispatcher->run("other");
-is_deeply([splice @calls], [
- 'app: first .*',
- 'app: second .*',
-]);
-
diff --git a/t/102-abort.t b/t/102-abort.t
deleted file mode 100644
index 6674973..0000000
--- a/t/102-abort.t
+++ /dev/null
@@ -1,58 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 2;
-
-my @calls;
-
-do {
- package MyFramework::Dispatcher;
- use Path::Dispatcher::Declarative -base;
- on qr/abort/ => sub {
- push @calls, 'framework on abort';
- };
-
- on qr/next rule/ => sub {
- push @calls, 'framework before next_rule';
- next_rule;
- push @calls, 'framework after next_rule';
- };
-
- on qr/next rule/ => sub {
- push @calls, 'framework before next_rule 2';
- next_rule;
- push @calls, 'framework after next_rule 2';
- };
-
- package MyApp::Dispatcher;
- # this hack is here because "use" expects there to be a file for the module
- BEGIN { MyFramework::Dispatcher->import("-base") }
-
- on qr/next rule/ => sub {
- push @calls, 'app before next_rule';
- next_rule;
- push @calls, 'app after next_rule';
- };
-
- on qr/next rule/ => sub {
- push @calls, 'app before next_rule 2';
- next_rule;
- push @calls, 'app after next_rule 2';
- };
-
- redispatch_to('MyFramework::Dispatcher');
-};
-
-MyApp::Dispatcher->run('abort');
-is_deeply([splice @calls], [
- 'framework on abort',
-]);
-
-MyApp::Dispatcher->run('next rule');
-is_deeply([splice @calls], [
- 'app before next_rule',
- 'app before next_rule 2',
- 'framework before next_rule',
- 'framework before next_rule 2',
-]);
-
diff --git a/t/103-input.t b/t/103-input.t
deleted file mode 100644
index 16329c9..0000000
--- a/t/103-input.t
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 1;
-
-my @calls;
-
-do {
- package MyFramework::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on qr/a(rg)s/ => sub {
- push @calls, {
- from => "framework",
- args => [@_],
- it => $_,
- one => $1,
- two => $2,
- };
- };
-
- package MyApp::Dispatcher;
- # this hack is here because "use" expects there to be a file for the module
- BEGIN { MyFramework::Dispatcher->import("-base") }
-
- on qr/ar(g)s/ => sub {
- push @calls, {
- from => "app",
- args => [@_],
- it => $_,
- one => $1,
- two => $2,
- };
- next_rule;
- };
-
- redispatch_to(MyFramework::Dispatcher->dispatcher);
-};
-
-MyApp::Dispatcher->run('args', 1..3);
-is_deeply([splice @calls], [
- {
- from => 'app',
- one => 'g',
- two => undef,
- it => 'args',
- args => [1, 2, 3],
- },
- {
- from => 'framework',
- one => 'rg',
- two => undef,
- it => 'args',
- args => [1, 2, 3],
- },
-]);
-
diff --git a/t/104-config.t b/t/104-config.t
deleted file mode 100644
index e72e57b..0000000
--- a/t/104-config.t
+++ /dev/null
@@ -1,31 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 5;
-
-my @calls;
-
-do {
- package RESTy::Dispatcher;
- use Path::Dispatcher::Declarative -base, -default => {
- token_delimiter => '/',
- case_sensitive_tokens => 0,
- };
-
- on ['=', 'model', 'Comment'] => sub { push @calls, $3 };
-};
-
-ok(RESTy::Dispatcher->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative sets up ISA");
-
-RESTy::Dispatcher->run('= model Comment');
-is_deeply([splice @calls], []);
-
-RESTy::Dispatcher->run('/=/model/Comment');
-is_deeply([splice @calls], ["Comment"]);
-
-RESTy::Dispatcher->run('/=/model/comment');
-is_deeply([splice @calls], ["comment"]);
-
-RESTy::Dispatcher->run('///=///model///COMMENT///');
-is_deeply([splice @calls], ["COMMENT"]);
-
diff --git a/t/105-empty.t b/t/105-empty.t
deleted file mode 100644
index 00b7840..0000000
--- a/t/105-empty.t
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 2;
-
-my @calls;
-
-do {
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on '' => sub {
- push @calls, "empty: $_";
- };
-};
-
-MyApp::Dispatcher->run("foo");
-is_deeply([splice @calls], []);
-
-MyApp::Dispatcher->run("");
-is_deeply([splice @calls], ["empty: "]);
-
diff --git a/t/106-metadata.t b/t/106-metadata.t
deleted file mode 100644
index b8d4c5e..0000000
--- a/t/106-metadata.t
+++ /dev/null
@@ -1,52 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 2;
-
-my @calls;
-
-do {
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on { method => 'GET' } => sub {
- push @calls, "method: GET, path: $_";
- };
-};
-
-my $path = Path::Dispatcher::Path->new(
- path => "/REST/Ticket/1.yml",
- metadata => {
- method => "GET",
- query_parameters => {
- owner => 'Sartak',
- status => 'closed',
- },
- },
-);
-
-MyApp::Dispatcher->run($path);
-is_deeply([splice @calls], ["method: GET, path: /REST/Ticket/1.yml"]);
-
-do {
- package MyApp::Other::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- on {
- query_parameters => {
- owner => qr/^\w+$/,
- },
- } => sub {
- push @calls, "query_parameters/owner/regex";
- };
-};
-
-TODO: {
- local $TODO = "metadata can't be a deep data structure";
-
- eval {
- MyApp::Other::Dispatcher->run($path);
- };
- is_deeply([splice @calls], ["query_parameters/owner/regex"]);
-};
-
diff --git a/t/200-under-next_rule.t b/t/200-under-next_rule.t
deleted file mode 100644
index 67e1fc1..0000000
--- a/t/200-under-next_rule.t
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 1;
-
-my @calls;
-
-do {
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- under first => sub {
- on qr/./ => sub {
- push @calls, "[$_] first -> regex";
- next_rule;
- };
-
- on second => sub {
- push @calls, "[$_] first -> string, via next_rule";
- };
- };
-};
-
-TODO: {
- local $TODO = "under doesn't pass its matched fragment as part of the path";
- MyApp::Dispatcher->run("first second");
- is_deeply([splice @calls], [
- "[first second] first -> regex",
- "[first second] first -> string, via next_rule",
- ]);
-}
-
diff --git a/t/300-complete-simple.t b/t/300-complete-simple.t
deleted file mode 100644
index fa5479e..0000000
--- a/t/300-complete-simple.t
+++ /dev/null
@@ -1,53 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-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;
- 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;
-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');
-
diff --git a/t/301-complete-complex.t b/t/301-complete-complex.t
deleted file mode 100644
index f57b02e..0000000
--- a/t/301-complete-complex.t
+++ /dev/null
@@ -1,73 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 16;
-
-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!" };
- };
-
- under beta => sub {
- on a => sub { die "do not call blocks!" };
- on b => 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('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!)";
- complete_ok(quux => 'quux-');
- complete_ok(b => 'bar', 'beta');
-};
-
diff --git a/t/302-complete-delimiter.t b/t/302-complete-delimiter.t
deleted file mode 100644
index 3f9f46a..0000000
--- a/t/302-complete-delimiter.t
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/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');
-
diff --git a/t/303-complete-alternation.t b/t/303-complete-alternation.t
deleted file mode 100644
index e05f56f..0000000
--- a/t/303-complete-alternation.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 20;
-
-do {
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- under gate => sub {
- on [ ['foo', 'bar', 'baz'] ] => sub { die };
- on quux => sub { die };
- };
-};
-
-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('z');
-complete_ok('gate z');
-complete_ok('zig ');
-complete_ok('zig f');
-complete_ok('zig fo');
-complete_ok('zig foo');
-
-complete_ok(g => 'gate');
-complete_ok(ga => 'gate');
-complete_ok(gat => 'gate');
-
-complete_ok(gate => 'gate foo', 'gate bar', 'gate baz', 'gate quux');
-complete_ok('gate ' => 'gate foo', 'gate bar', 'gate baz', 'gate quux');
-
-complete_ok('gate f' => 'gate foo');
-
-complete_ok('gate b' => 'gate bar', 'gate baz');
-complete_ok('gate ba' => 'gate bar', 'gate baz');
-
-complete_ok('gate q' => 'gate quux');
-complete_ok('gate quu' => 'gate quux');
-
-complete_ok('gate foo');
-complete_ok('gate bar');
-complete_ok('gate baz');
-complete_ok('gate quux');
-
diff --git a/t/304-complete-enum.t b/t/304-complete-enum.t
deleted file mode 100644
index dddbf2e..0000000
--- a/t/304-complete-enum.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 20;
-
-do {
- package MyApp::Dispatcher;
- use Path::Dispatcher::Declarative -base;
-
- under gate => sub {
- on enum('foo', 'bar', 'baz') => sub { die };
- on quux => sub { die };
- };
-};
-
-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('z');
-complete_ok('gate z');
-complete_ok('zig ');
-complete_ok('zig f');
-complete_ok('zig fo');
-complete_ok('zig foo');
-
-complete_ok(g => 'gate');
-complete_ok(ga => 'gate');
-complete_ok(gat => 'gate');
-
-complete_ok(gate => 'gate foo', 'gate bar', 'gate baz', 'gate quux');
-complete_ok('gate ' => 'gate foo', 'gate bar', 'gate baz', 'gate quux');
-
-complete_ok('gate f' => 'gate foo');
-
-complete_ok('gate b' => 'gate bar', 'gate baz');
-complete_ok('gate ba' => 'gate bar', 'gate baz');
-
-complete_ok('gate q' => 'gate quux');
-complete_ok('gate quu' => 'gate quux');
-
-complete_ok('gate foo');
-complete_ok('gate bar');
-complete_ok('gate baz');
-complete_ok('gate quux');
-
diff --git a/t/800-cb-slash-path-delimiter.t b/t/800-cb-slash-path-delimiter.t
deleted file mode 100644
index f91f35b..0000000
--- a/t/800-cb-slash-path-delimiter.t
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-my @result;
-
-do {
- package MyDispatcher;
- use Path::Dispatcher::Declarative -base, -default => {
- token_delimiter => '/',
- };
-
- under show => sub {
- on inventory => sub {
- push @result, "inventory";
- };
- on score => sub {
- push @result, "score";
- };
- };
-};
-
-MyDispatcher->run('show/inventory');
-is_deeply([splice @result], ['inventory']);
-
-MyDispatcher->run('show/score');
-is_deeply([splice @result], ['score']);
-
-MyDispatcher->run('show inventory');
-is_deeply([splice @result], []);
-
diff --git a/t/801-cb-chaining.t b/t/801-cb-chaining.t
deleted file mode 100644
index 415c0df..0000000
--- a/t/801-cb-chaining.t
+++ /dev/null
@@ -1,34 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 3;
-
-my @result;
-
-do {
- package MyDispatcher;
- use Path::Dispatcher::Declarative -base;
-
- under show => sub {
- then {
- push @result, "Displaying";
- };
- on inventory => sub {
- push @result, "inventory";
- };
- on score => sub {
- push @result, "score";
- };
- };
-};
-
-MyDispatcher->run('show inventory');
-is_deeply([splice @result], ['Displaying', 'inventory']);
-
-MyDispatcher->run('show score');
-is_deeply([splice @result], ['Displaying', 'score']);
-
-MyDispatcher->run('show');
-is_deeply([splice @result], ['Displaying']); # This is kinda weird
-
-
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list