[Bps-public-commit] r15432 - in Path-Dispatcher/trunk: lib/Path lib/Path/Dispatcher lib/Path/Dispatcher/Dispatch
sartak at bestpractical.com
sartak at bestpractical.com
Mon Aug 25 16:12:06 EDT 2008
Author: sartak
Date: Mon Aug 25 16:12:04 2008
New Revision: 15432
Added:
Path-Dispatcher/trunk/lib/Path/Dispatcher/Stage.pm
Modified:
Path-Dispatcher/trunk/ (props changed)
Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm
Log:
r70288 at onn: sartak | 2008-08-25 14:21:24 -0400
Reify dispatch stage so we can have more logic in it
Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher.pm (original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher.pm Mon Aug 25 16:12:04 2008
@@ -3,9 +3,11 @@
use Moose;
use MooseX::AttributeHelpers;
+use Path::Dispatcher::Stage;
use Path::Dispatcher::Rule;
use Path::Dispatcher::Dispatch;
+sub stage_class { 'Path::Dispatcher::Stage' }
sub dispatch_class { 'Path::Dispatcher::Dispatch' }
has _rules => (
@@ -36,37 +38,31 @@
},
);
-has _stages => (
+has stages => (
metaclass => 'Collection::Array',
is => 'rw',
- isa => 'ArrayRef[Str]',
- default => sub { [ 'on' ] },
- provides => {
- push => 'push_stage',
- unshift => 'unshift_stage',
- },
+ isa => 'ArrayRef[Path::Dispatcher::Stage]',
+ auto_deref => 1,
+ builder => 'default_stages',
);
-sub stage_names {
- my $self = shift;
-
- return ('first', @{ $self->_stages }, 'last');
-}
-
-sub stages {
+sub default_stages {
my $self = shift;
+ my $stage_class = $self->stage_class;
my @stages;
- for my $stage ($self->stage_names) {
- for my $substage ('before', 'on', 'after') {
- my $qualified_stage = $substage eq 'on'
- ? $stage
- : "${substage}_$stage";
- push @stages, $qualified_stage;
+ for my $stage_name (qw/first on last/) {
+ for my $qualifier (qw/before on after/) {
+ my $is_qualified = $qualifier ne 'on';
+ my $stage = $stage_class->new(
+ name => $stage_name,
+ ($is_qualified ? (qualifier => $qualifier) : ()),
+ );
+ push @stages, $stage;
}
}
- return @stages;
+ return \@stages;
}
sub dispatch {
@@ -84,7 +80,9 @@
for my $stage ($self->stages) {
$self->begin_stage($stage, \@matches);
- for my $rule (@{ delete $rules_for_stage{$stage}||[] }) {
+ my $stage_name = $stage->qualified_name;
+
+ for my $rule (@{ delete $rules_for_stage{$stage_name} || [] }) {
my $vars = $rule->match($path)
or next;
Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm (original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Dispatch/Match.pm Mon Aug 25 16:12:04 2008
@@ -2,9 +2,12 @@
package Path::Dispatcher::Dispatch::Match;
use Moose;
+use Path::Dispatcher::Stage;
+use Path::Dispatcher::Rule;
+
has stage => (
is => 'ro',
- isa => 'Str',
+ isa => 'Path::Dispatcher::Stage',
required => 1,
);
Added: Path-Dispatcher/trunk/lib/Path/Dispatcher/Stage.pm
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Stage.pm Mon Aug 25 16:12:04 2008
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+package Path::Dispatcher::Stage;
+use Moose;
+
+has name => (
+ is => 'ro',
+ isa => 'Str',
+);
+
+has qualifier => (
+ is => 'ro',
+ isa => 'Str',
+ predicate => 'is_qualified',
+);
+
+sub qualified_name {
+ my $self = shift;
+ my $name = $self->name;
+
+ return $self->qualifier . '_' . $name if $self->is_qualified;
+ return $name;
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
+1;
+
More information about the Bps-public-commit
mailing list