X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FDispatchType%2FChained.pm;h=5bf3853c10ff68695be34675f15c869124e5d459;hp=0dc4c256002712dd2a2ccb0ffb31b405bfc0d066;hb=f3414019f472b55682ef3af53f761b6db7955887;hpb=e8b9f2a92084b3b9dab6b2b879900481b8548b3b diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 0dc4c25..5bf3853 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -1,14 +1,36 @@ package Catalyst::DispatchType::Chained; +use Class::C3; use Moose; extends 'Catalyst::DispatchType'; -#use strict; -#use base qw/Catalyst::DispatchType/; use Text::SimpleTable; use Catalyst::ActionChain; use URI; +has _endpoints => ( + is => 'rw', + isa => 'ArrayRef', + required => 1, + default => sub{ [] }, + ); + +has _actions => ( + is => 'rw', + isa => 'HashRef', + required => 1, + default => sub{ {} }, + ); + +has _children_of => ( + is => 'rw', + isa => 'HashRef', + required => 1, + default => sub{ {} }, + ); + +no Moose; + # please don't perltidy this. hairy code within. =head1 NAME @@ -44,7 +66,7 @@ Debug output for Path Part dispatch points sub list { my ( $self, $c ) = @_; - return unless $self->{endpoints}; + return unless $self->_endpoints; my $paths = Text::SimpleTable->new( [ 35, 'Path Spec' ], [ 36, 'Private' ] @@ -52,7 +74,7 @@ sub list { ENDPOINT: foreach my $endpoint ( sort { $a->reverse cmp $b->reverse } - @{ $self->{endpoints} } + @{ $self->_endpoints } ) { my $args = $endpoint->attributes->{Args}->[0]; my @parts = (defined($args) ? (("*") x $args) : '...'); @@ -68,7 +90,7 @@ sub list { if (defined $pp->[0] && length $pp->[0]); } $parent = $curr->attributes->{Chained}->[0]; - $curr = $self->{actions}{$parent}; + $curr = $self->_actions->{$parent}; unshift(@parents, $curr) if $curr; } next ENDPOINT unless $parent eq '/'; # skip dangling action @@ -100,20 +122,21 @@ Calls C to see if a chain matches the C<$path>. sub match { my ( $self, $c, $path ) = @_; - return 0 if @{$c->req->args}; + my $request = $c->request; + return 0 if @{$request->args}; my @parts = split('/', $path); my ($chain, $captures, $parts) = $self->recurse_match($c, '/', \@parts); - push @{$c->req->args}, @$parts if $parts && @$parts; + push @{$request->args}, @$parts if $parts && @$parts; return 0 unless $chain; my $action = Catalyst::ActionChain->from_chain($chain); - $c->req->action("/${action}"); - $c->req->match("/${action}"); - $c->req->captures($captures); + $request->action("/${action}"); + $request->match("/${action}"); + $request->captures($captures); $c->action($action); $c->namespace( $action->namespace ); @@ -128,7 +151,7 @@ Recursive search for a matching chain. sub recurse_match { my ( $self, $c, $parent, $path_parts ) = @_; - my $children = $self->{children_of}{$parent}; + my $children = $self->_children_of->{$parent}; return () unless $children; my $best_action; my @captures; @@ -178,7 +201,7 @@ sub recurse_match { # No best action currently # OR This one matches with fewer parts left than the current best action, # And therefore is a better match - # OR No parts and this expects 0 + # OR No parts and this expects 0 # The current best action might also be Args(0), # but we couldn't chose between then anyway so we'll take the last seen @@ -235,7 +258,7 @@ sub register { $action->attributes->{Chained} = [ $parent ]; - my $children = ($self->{children_of}{$parent} ||= {}); + my $children = ($self->_children_of->{$parent} ||= {}); my @path_part = @{ $action->attributes->{PathPart} || [] }; @@ -245,13 +268,13 @@ sub register { $part = $path_part[0]; } elsif (@path_part > 1) { Catalyst::Exception->throw( - "Multiple PathPart attributes not supported registering ${action}" + "Multiple PathPart attributes not supported registering " . $action->reverse() ); } if ($part =~ m(^/)) { Catalyst::Exception->throw( - "Absolute parameters to PathPart not allowed registering ${action}" + "Absolute parameters to PathPart not allowed registering " . $action->reverse() ); } @@ -259,10 +282,10 @@ sub register { unshift(@{ $children->{$part} ||= [] }, $action); - ($self->{actions} ||= {})->{'/'.$action->reverse} = $action; + $self->_actions->{'/'.$action->reverse} = $action; unless ($action->attributes->{CaptureArgs}) { - unshift(@{ $self->{endpoints} ||= [] }, $action); + unshift(@{ $self->_endpoints }, $action); } return 1; @@ -297,7 +320,7 @@ sub uri_for_action { if (defined($pp->[0]) && length($pp->[0])); } $parent = $curr->attributes->{Chained}->[0]; - $curr = $self->{actions}{$parent}; + $curr = $self->_actions->{$parent}; } return undef unless $parent eq '/'; # fail for dangling action @@ -305,9 +328,11 @@ sub uri_for_action { return undef if @captures; # fail for too many captures return join('/', '', @parts); - + } +__PACKAGE__->meta->make_immutable; + =head1 USAGE =head2 Introduction @@ -466,7 +491,7 @@ this debugging output: '-----------------------+------------------------------' ... -Here's a more detailed specification of the attributes belonging to +Here's a more detailed specification of the attributes belonging to C<:Chained>: =head2 Attributes