[Bps-public-commit] r14895 - in Path-Dispatcher/trunk: lib/Path lib/Path/Dispatcher lib/Path/Dispatcher/Dispatch t
sartak at bestpractical.com
sartak at bestpractical.com
Thu Aug 7 13:48:30 EDT 2008
Author: sartak
Date: Thu Aug 7 13:48:29 2008
New Revision: 14895
Added:
Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/
Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch.pm
Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm
Modified:
Path-Dispatcher/trunk/ (props changed)
Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
Path-Dispatcher/trunk/t/001-api.t
Path-Dispatcher/trunk/t/003-404.t
Path-Dispatcher/trunk/t/006-abort.t
Path-Dispatcher/trunk/t/009-args.t
Path-Dispatcher/trunk/t/010-return.t
Log:
r68937 at onn: sartak | 2008-08-07 13:47:31 -0400
Reify dispatch and dispatch match, refactor super dispatcher to just splat its matches into the current dispatch's matches
Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher.pm (original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher.pm Thu Aug 7 13:48:29 2008
@@ -4,8 +4,10 @@
use MooseX::AttributeHelpers;
use Path::Dispatcher::Rule;
+use Path::Dispatcher::Dispatch;
-sub rule_class { 'Path::Dispatcher::Rule' }
+sub rule_class { 'Path::Dispatcher::Rule' }
+sub dispatch_class { 'Path::Dispatcher::Dispatch' }
has _rules => (
metaclass => 'Collection::Array',
@@ -76,6 +78,8 @@
my @matches;
my %rules_for_stage;
+ my $dispatch = $self->dispatch_class->new;
+
push @{ $rules_for_stage{$_->stage} }, $_
for $self->rules;
@@ -91,17 +95,17 @@
my $vars = $rule->match($path)
or next;
- push @matches, {
+ $dispatch->add_match(
stage => $qualified_stage,
rule => $rule,
result => $vars,
- };
-
- last if !$rule->fallthrough;
+ );
}
if ($self->defer_to_super_dispatcher($qualified_stage, \@matches)) {
- push @matches, $self->super_dispatcher->dispatch($path);
+ $dispatch->add_redispatch(
+ $self->super_dispatcher->dispatch($path)
+ );
}
$self->end_stage($qualified_stage, \@matches);
@@ -111,72 +115,15 @@
warn "Unhandled stages: " . join(', ', keys %rules_for_stage)
if keys %rules_for_stage;
- return if !@matches;
-
- return $self->build_runner(
- path => $path,
- matches => \@matches,
- );
-}
-
-sub build_runner {
- my $self = shift;
- my %args = @_;
-
- my $path = $args{path};
- my $matches = $args{matches};
-
- return sub {
- my @args = @_;
-
- eval {
- local $SIG{__DIE__} = 'DEFAULT';
- for my $match (@$matches) {
- if (ref($match) eq 'CODE') {
- $match->(@args);
- next;
- }
-
- # if we need to set $1, $2..
- if (ref($match->{result}) eq 'ARRAY') {
- $self->run_with_number_vars(
- sub { $match->{rule}->run(@args) },
- @{ $match->{result} },
- );
- }
- else {
- $match->{rule}->run(@args);
- }
- }
- };
-
- die $@ if $@ && $@ !~ /^Patch::Dispatcher abort\n/;
-
- return;
- };
-}
-
-sub run_with_number_vars {
- my $self = shift;
- my $code = shift;
-
- # we don't have direct write access to $1 and friends, so we have to
- # do this little hack. the only way we can update $1 is by matching
- # against a regex (5.10 fixes that)..
- my $re = join '', map { "(\Q$_\E)" } @_;
- my $str = join '', @_;
- $str =~ $re
- or die "Unable to match '$str' against a copy of itself!";
-
- $code->();
+ return $dispatch;
}
sub run {
my $self = shift;
my $path = shift;
- my $code = $self->dispatch($path);
+ my $dispatch = $self->dispatch($path);
- $code->(@_);
+ $dispatch->run(@_);
return;
}
Added: Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch.pm
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch.pm Thu Aug 7 13:48:29 2008
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+package Path::Dispatcher::Dispatch;
+use Moose;
+
+use Path::Dispatcher::Dispatch::Match;
+sub match_class { 'Path::Dispatcher::Dispatch::Match' }
+
+has _matches => (
+ metaclass => 'Collection::Array',
+ is => 'rw',
+ isa => 'ArrayRef[Path::Dispatcher::Dispatch::Match]',
+ default => sub { [] },
+ provides => {
+ push => '_add_match',
+ elements => 'matches',
+ },
+);
+
+sub add_redispatch {
+ my $self = shift;
+ my $dispatch = shift;
+
+ for my $match ($dispatch->matches) {
+ $self->add_match($match);
+ }
+}
+
+sub add_match {
+ my $self = shift;
+
+ my $match;
+
+ # they pass in an already instantiated match..
+ if (@_ == 1 && blessed($_[0])) {
+ $match = shift;
+ }
+ # or they pass in args to create a match..
+ else {
+ $match = $self->match_class->new(@_);
+ }
+
+ $self->_add_match($match);
+}
+
+sub run {
+ my $self = shift;
+ my @args = @_;
+
+ eval {
+ local $SIG{__DIE__} = 'DEFAULT';
+ for my $match ($self->matches) {
+ # if we need to set $1, $2..
+ if ($match->set_number_vars) {
+ $self->run_with_number_vars(
+ sub { $match->rule->run(@args) },
+ @{ $match->result },
+ );
+ }
+ else {
+ $match->rule->run(@args);
+ }
+ }
+ };
+
+ die $@ if $@ && $@ !~ /^Patch::Dispatcher abort\n/;
+
+ return;
+}
+
+sub run_with_number_vars {
+ my $self = shift;
+ my $code = shift;
+
+ # we don't have direct write access to $1 and friends, so we have to
+ # do this little hack. the only way we can update $1 is by matching
+ # against a regex (5.10 fixes that)..
+ my $re = join '', map { "(\Q$_\E)" } @_;
+ my $str = join '', @_;
+ $str =~ $re
+ or die "Unable to match '$str' against a copy of itself!";
+
+ $code->();
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+
Added: Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm Thu Aug 7 13:48:29 2008
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+package Path::Dispatcher::Dispatch::Match;
+use Moose;
+
+has stage => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has rule => (
+ is => 'ro',
+ isa => 'Path::Dispatcher::Rule',
+ required => 1,
+);
+
+has result => (
+ is => 'ro',
+);
+
+has set_number_vars => (
+ is => 'ro',
+ isa => 'Bool',
+ lazy => 1,
+ default => sub { ref(shift->result) eq 'ARRAY' },
+);
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+
Modified: Path-Dispatcher/trunk/t/001-api.t
==============================================================================
--- Path-Dispatcher/trunk/t/001-api.t (original)
+++ Path-Dispatcher/trunk/t/001-api.t Thu Aug 7 13:48:29 2008
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 12;
use Path::Dispatcher;
my @calls;
@@ -14,10 +14,11 @@
is_deeply([splice @calls], [], "no calls to the rule block yet");
-my $thunk = $dispatcher->dispatch('foo');
+my $dispatch = $dispatcher->dispatch('foo');
is_deeply([splice @calls], [], "no calls to the rule block yet");
-$thunk->();
+isa_ok($dispatch, 'Path::Dispatcher::Dispatch');
+$dispatch->run;
is_deeply([splice @calls], [ [] ], "finally invoked the rule block");
$dispatcher->run('foo');
@@ -30,10 +31,11 @@
is_deeply([splice @calls], [], "no calls to the rule block yet");
-$thunk = $dispatcher->dispatch('bar');
+$dispatch = $dispatcher->dispatch('bar');
is_deeply([splice @calls], [], "no calls to the rule block yet");
-$thunk->();
+isa_ok($dispatch, 'Path::Dispatcher::Dispatch');
+$dispatch->run;
is_deeply([splice @calls], [ ['bar', undef] ], "finally invoked the rule block");
$dispatcher->run('bar');
@@ -41,6 +43,7 @@
"foo" =~ /foo/;
-$thunk->();
+isa_ok($dispatch, 'Path::Dispatcher::Dispatch');
+$dispatch->run;
is_deeply([splice @calls], [ ['bar', undef] ], "invoked the rule block on 'run', makes sure \$1 etc are still correctly set");
Modified: Path-Dispatcher/trunk/t/003-404.t
==============================================================================
--- Path-Dispatcher/trunk/t/003-404.t (original)
+++ Path-Dispatcher/trunk/t/003-404.t Thu Aug 7 13:48:29 2008
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 4;
use Path::Dispatcher;
my @calls;
@@ -12,8 +12,12 @@
block => sub { push @calls, [@_] },
);
-my $thunk = $dispatcher->dispatch('bar');
+my $dispatch = $dispatcher->dispatch('bar');
is_deeply([splice @calls], [], "no calls to the rule block yet");
-is($thunk, undef, "no match, no coderef");
+isa_ok($dispatch, 'Path::Dispatcher::Dispatch');
+is($dispatch->matches, 0, "no matches");
+
+$dispatch->run;
+is_deeply([splice @calls], [], "no calls to the rule block");
Modified: Path-Dispatcher/trunk/t/006-abort.t
==============================================================================
--- Path-Dispatcher/trunk/t/006-abort.t (original)
+++ Path-Dispatcher/trunk/t/006-abort.t Thu Aug 7 13:48:29 2008
@@ -24,14 +24,14 @@
},
);
-my $thunk;
+my $dispatch;
lives_ok {
- $thunk = $dispatcher->dispatch('foo');
+ $dispatch = $dispatcher->dispatch('foo');
};
is_deeply([splice @calls], [], "no blocks called yet of course");
lives_ok {
- $thunk->();
+ $dispatch->run;
};
is_deeply([splice @calls], ['on'], "correctly aborted the entire dispatch");
Modified: Path-Dispatcher/trunk/t/009-args.t
==============================================================================
--- Path-Dispatcher/trunk/t/009-args.t (original)
+++ Path-Dispatcher/trunk/t/009-args.t Thu Aug 7 13:48:29 2008
@@ -18,8 +18,8 @@
[42],
]);
-my $code = $dispatcher->dispatch('foo');
-$code->(24);
+my $dispatch = $dispatcher->dispatch('foo');
+$dispatch->run(24);
is_deeply([splice @calls], [
[24],
Modified: Path-Dispatcher/trunk/t/010-return.t
==============================================================================
--- Path-Dispatcher/trunk/t/010-return.t (original)
+++ Path-Dispatcher/trunk/t/010-return.t Thu Aug 7 13:48:29 2008
@@ -14,8 +14,8 @@
is_deeply([$dispatcher->run('foo', 42)], []);
-my $code = $dispatcher->dispatch('foo');
-is_deeply([$code->(24)], []);
+my $dispatch = $dispatcher->dispatch('foo');
+is_deeply([$dispatch->run(24)], []);
for my $stage (qw/first on last/) {
for my $substage (qw/before on after/) {
@@ -32,6 +32,6 @@
is_deeply([$dispatcher->run('foo', 42)], []);
-$code = $dispatcher->dispatch('foo');
-is_deeply([$code->(24)], []);
+$dispatch = $dispatcher->dispatch('foo');
+is_deeply([$dispatch->run(24)], []);
More information about the Bps-public-commit
mailing list