[Bps-public-commit] Path-Dispatcher branch, master, updated. 8b8043934d379e31469dc98cd9d51b3302bed497
sartak at bestpractical.com
sartak at bestpractical.com
Fri Mar 6 21:16:58 EST 2009
The branch, master has been updated
via 8b8043934d379e31469dc98cd9d51b3302bed497 (commit)
from e137f5467e72f14b688c4e4043f621ff271fc670 (commit)
Summary of changes:
lib/Path/Dispatcher/Builder.pm | 5 +-
lib/Path/Dispatcher/Declarative.pm | 256 ------------------------------------
2 files changed, 2 insertions(+), 259 deletions(-)
- Log -----------------------------------------------------------------
commit 8b8043934d379e31469dc98cd9d51b3302bed497
Author: Shawn M Moore <sartak at gmail.com>
Date: Fri Mar 6 21:16:54 2009 -0500
Some cleanup
diff --git a/lib/Path/Dispatcher/Builder.pm b/lib/Path/Dispatcher/Builder.pm
index 90397c9..ba9d7a1 100644
--- a/lib/Path/Dispatcher/Builder.pm
+++ b/lib/Path/Dispatcher/Builder.pm
@@ -4,19 +4,18 @@ use Any::Moose;
has dispatcher => (
is => 'ro',
isa => 'Path::Dispatcher',
- required => 1,
lazy => 1,
default => sub { return Path::Dispatcher->new },
);
has case_sensitive_tokens => (
- is => 'rw',
+ is => 'rw',
isa => 'Bool|CodeRef',
default => 0,
);
has token_delimiter => (
- is => 'rw',
+ is => 'rw',
isa => 'Str|CodeRef',
default => ' ',
);
diff --git a/lib/Path/Dispatcher/Declarative.pm b/lib/Path/Dispatcher/Declarative.pm
index 3c09df2..0f73bea 100644
--- a/lib/Path/Dispatcher/Declarative.pm
+++ b/lib/Path/Dispatcher/Declarative.pm
@@ -90,262 +90,6 @@ sub build_sugar {
last_rule => \&_last_rule,
};
}
-__END__
-
-our $CALLER; # Sub::Exporter doesn't make this available
-our $OUTERMOST_DISPATCHER;
-our $UNDER_RULE;
-
-my $exporter = Sub::Exporter::build_exporter({
- into_level => 1,
- groups => {
- default => \&build_sugar,
- },
-});
-
-sub token_delimiter { ' ' }
-sub case_sensitive_tokens { undef }
-
-sub _next_rule () {
- die "Path::Dispatcher next rule\n";
-}
-
-sub _last_rule () {
- die "Path::Dispatcher abort\n";
-}
-
-sub import {
- my $self = shift;
- my $pkg = caller;
-
- my @args = grep { !/^-[bB]ase$/ } @_;
-
- # 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;
-
- my $dispatcher = Path::Dispatcher->new(
- name => $into,
- );
-
- return {
- dispatcher => sub { $dispatcher },
- dispatch => sub {
- # if caller is $into, then this function is being used as sugar
- # otherwise, it's probably a method call, so discard the invocant
- shift if caller ne $into;
-
- local $OUTERMOST_DISPATCHER = $dispatcher
- if !$OUTERMOST_DISPATCHER;
-
- $OUTERMOST_DISPATCHER->dispatch(@_);
- },
- run => sub {
- # if caller is $into, then this function is being used as sugar
- # otherwise, it's probably a method call, so discard the invocant
- shift if caller ne $into;
-
- local $OUTERMOST_DISPATCHER = $dispatcher
- if !$OUTERMOST_DISPATCHER;
-
- $OUTERMOST_DISPATCHER->run(@_);
- },
- rewrite => sub {
- my ($from, $to) = @_;
- my $rewrite = sub {
- local $OUTERMOST_DISPATCHER = $dispatcher
- if !$OUTERMOST_DISPATCHER;
- my $path = ref($to) eq 'CODE' ? $to->() : $to;
- $OUTERMOST_DISPATCHER->run($path, @_);
- };
- $into->_add_rule('on', $from, $rewrite);
- },
- on => sub {
- $into->_add_rule('on', @_);
- },
- before => sub {
- $into->_add_rule('before_on', @_);
- },
- after => sub {
- $into->_add_rule('after_on', @_);
- },
- then => sub (&) {
- my $block = shift;
- my $rule = Path::Dispatcher::Rule::Always->new(
- stage => 'on',
- block => sub {
- $block->(@_);
- _next_rule;
- },
- );
- $into->_add_rule($rule);
- },
- chain => sub (&) {
- my $block = shift;
- my $rule = Path::Dispatcher::Rule::Chain->new(
- stage => 'on',
- block => $block,
- );
- $into->_add_rule($rule);
- },
- under => sub {
- my ($matcher, $rules) = @_;
-
- my $predicate = $into->_create_rule('on', $matcher);
- $predicate->prefix(1);
-
- my $under = Path::Dispatcher::Rule::Under->new(
- predicate => $predicate,
- );
-
- $into->_add_rule($under, @_);
-
- do {
- local $UNDER_RULE = $under;
- $rules->();
- };
- },
- redispatch_to => sub {
- my ($dispatcher) = @_;
-
- # assume it's a declarative dispatcher
- if (!ref($dispatcher)) {
- $dispatcher = $dispatcher->dispatcher;
- }
-
- my $redispatch = Path::Dispatcher::Rule::Dispatch->new(
- dispatcher => $dispatcher,
- );
-
- $into->_add_rule($redispatch);
- },
- next_rule => \&_next_rule,
- last_rule => \&_last_rule,
- };
-}
-
-my %rule_creators = (
- ARRAY => sub {
- my ($self, $stage, $tokens, $block) = @_;
- my $case_sensitive = $self->case_sensitive_tokens;
-
- Path::Dispatcher::Rule::Tokens->new(
- tokens => $tokens,
- delimiter => $self->token_delimiter,
- defined $case_sensitive ? (case_sensitive => $case_sensitive) : (),
- $block ? (block => $block) : (),
- ),
- },
- HASH => sub {
- my ($self, $stage, $metadata_matchers, $block) = @_;
-
- if (keys %$metadata_matchers == 1) {
- my ($field) = keys %$metadata_matchers;
- my ($value) = values %$metadata_matchers;
- my $matcher = $self->_create_rule($stage, $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, $stage, $matcher, $block) = @_;
- Path::Dispatcher::Rule::CodeRef->new(
- matcher => $matcher,
- $block ? (block => $block) : (),
- ),
- },
- Regexp => sub {
- my ($self, $stage, $regex, $block) = @_;
- Path::Dispatcher::Rule::Regex->new(
- regex => $regex,
- $block ? (block => $block) : (),
- ),
- },
- empty => sub {
- my ($self, $stage, $undef, $block) = @_;
- Path::Dispatcher::Rule::Empty->new(
- $block ? (block => $block) : (),
- ),
- },
-);
-
-sub _create_rule {
- my ($self, $stage, $matcher, $block) = @_;
-
- my $rule_creator;
-
- if ($matcher eq '') {
- $rule_creator = $rule_creators{empty};
- }
- elsif (!ref($matcher)) {
- $rule_creator = $rule_creators{ARRAY};
- $matcher = [$matcher];
- }
- else {
- $rule_creator = $rule_creators{ ref $matcher };
- }
-
- $rule_creator or die "I don't know how to create a rule for type $matcher";
-
- return $rule_creator->($self, $stage, $matcher, $block);
-}
-
-sub _add_rule {
- my $self = shift;
- my $rule;
-
- if (!ref($_[0])) {
- my ($stage, $matcher, $block) = splice @_, 0, 3;
- $rule = $self->_create_rule($stage, $matcher, $block);
- }
- else {
- $rule = shift;
- }
-
- # XXX: caller level should be closer to $Test::Builder::Level
- my (undef, $file, $line) = caller(1);
- 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);
- }
- else {
- $self->dispatcher->add_rule($rule);
- $rule->name("(" . $self->dispatcher->name . " - rule $rule_name)");
- }
- }
- else {
- $rule->name($rule_name);
- return $rule, @_;
- }
-}
1;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list