[Bps-public-commit] r16364 - in Path-Dispatcher/trunk: lib/Path/Dispatcher lib/Path/Dispatcher/Rule t
sartak at bestpractical.com
sartak at bestpractical.com
Sun Oct 19 06:17:04 EDT 2008
Author: sartak
Date: Sun Oct 19 06:17:04 2008
New Revision: 16364
Added:
Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Under.pm
Path-Dispatcher/trunk/t/012-under.t
Modified:
Path-Dispatcher/trunk/ (props changed)
Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm
Log:
r74129 at onn: sartak | 2008-10-19 06:16:43 -0400
"under" rules
Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm (original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm Sun Oct 19 06:17:04 2008
@@ -68,6 +68,7 @@
require Path::Dispatcher::Rule::CodeRef;
require Path::Dispatcher::Rule::Regex;
require Path::Dispatcher::Rule::Tokens;
+require Path::Dispatcher::Rule::Under;
1;
Added: Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Under.pm
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Under.pm Sun Oct 19 06:17:04 2008
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+package Path::Dispatcher::Rule::Under;
+use Moose;
+use MooseX::AttributeHelpers;
+extends 'Path::Dispatcher::Rule';
+
+has predicate => (
+ is => 'ro',
+ isa => 'Path::Dispatcher::Rule',
+);
+
+has _rules => (
+ metaclass => 'Collection::Array',
+ is => 'rw',
+ isa => 'ArrayRef[Path::Dispatcher::Rule]',
+ init_arg => 'rules',
+ default => sub { [] },
+ provides => {
+ push => 'add_rule',
+ elements => 'rules',
+ },
+);
+
+sub match {
+ my $self = shift;
+ my $path = shift;
+
+ my $prefix_match = $self->predicate->match($path)
+ or return;
+
+ my $suffix = $prefix_match->leftover;
+
+ return grep { defined } map { $_->match($suffix) } $self->rules;
+}
+
+1;
+
Added: Path-Dispatcher/trunk/t/012-under.t
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/t/012-under.t Sun Oct 19 06:17:04 2008
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 9;
+use Path::Dispatcher;
+
+my @calls;
+
+my $predicate = Path::Dispatcher::Rule::Tokens->new(
+ tokens => ['ticket'],
+ prefix => 1,
+);
+
+my $create = Path::Dispatcher::Rule::Tokens->new(
+ tokens => ['create'],
+ block => sub { push @calls, "ticket create" },
+);
+
+my $update = Path::Dispatcher::Rule::Tokens->new(
+ tokens => ['update'],
+ block => sub { push @calls, "ticket update" },
+);
+
+my $under = Path::Dispatcher::Rule::Under->new(
+ predicate => $predicate,
+ rules => [$create, $update],
+);
+
+my ($ticket_create) = $under->match("ticket create");
+ok($ticket_create, "matched 'ticket create'");
+
More information about the Bps-public-commit
mailing list