[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