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=18e7c5928e81fc81f37d037fd4a1722eb1beaf2e;hp=df9c1a6950c183c6dfa0cee6b38d4fbf0af95c12;hb=634780e00f88651be2fe6f261d56604e313b369a;hpb=250cad0f65cf92f1a48dcbd7db4952970563a3c2 diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index df9c1a6..18e7c59 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -1,11 +1,36 @@ package Catalyst::DispatchType::Chained; -use strict; -use base qw/Catalyst::DispatchType/; +use Moose; +extends 'Catalyst::DispatchType'; + use Text::SimpleTable; use Catalyst::ActionChain; +use Catalyst::Utils; 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 @@ -14,6 +39,8 @@ Catalyst::DispatchType::Chained - Path Part DispatchType =head1 SYNOPSIS +Path part matching, allowing several actions to sequentially take care of processing a request: + # root action - captures one argument after it sub foo_setup : Chained('/') PathPart('foo') CaptureArgs(1) { my ( $self, $c, $foo_arg ) = @_; @@ -28,7 +55,16 @@ Catalyst::DispatchType::Chained - Path Part DispatchType =head1 DESCRIPTION -See L. +Dispatch type managing default behaviour. For more information on +dispatch types, see: + +=over 4 + +=item * L for how they affect application authors + +=item * L for implementation information. + +=back =head1 METHODS @@ -41,15 +77,21 @@ Debug output for Path Part dispatch points sub list { my ( $self, $c ) = @_; - return unless $self->{endpoints}; + return unless $self->_endpoints; + my $column_width = Catalyst::Utils::term_width() - 35 - 9; my $paths = Text::SimpleTable->new( - [ 35, 'Path Spec' ], [ 36, 'Private' ] - ); + [ 35, 'Path Spec' ], [ $column_width, 'Private' ], + ); + + my $has_unattached_actions; + my $unattached_actions = Text::SimpleTable->new( + [ 35, 'Private' ], [ $column_width, 'Missing parent' ], + ); 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) : '...'); @@ -65,10 +107,14 @@ 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 + if ($parent ne '/') { + $has_unattached_actions = 1; + $unattached_actions->row('/' . ($parents[0] || $endpoint)->reverse, $parent); + next ENDPOINT; + } my @rows; foreach my $p (@parents) { my $name = "/${p}"; @@ -81,11 +127,13 @@ sub list { push(@rows, [ '', $name ]); } push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]); - $rows[0][0] = join('/', '', @parts); + $rows[0][0] = join('/', '', @parts) || '/'; $paths->row(@$_) for @rows; } $c->log->debug( "Loaded Chained actions:\n" . $paths->draw . "\n" ); + $c->log->debug( "Unattached Chained actions:\n", $unattached_actions->draw . "\n" ) + if $has_unattached_actions; } =head2 $self->match( $c, $path ) @@ -97,20 +145,27 @@ 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; + + if ($parts && @$parts) { + for my $arg (@$parts) { + $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + push @{$request->args}, $arg; + } + } 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 ); @@ -125,7 +180,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; @@ -220,8 +275,13 @@ sub register { "Multiple Chained attributes not supported registering ${action}" ); } + my $chained_to = $chained_attr[0]; - my $children = ($self->{children_of}{ $chained_attr[0] } ||= {}); + Catalyst::Exception->throw( + "Actions cannot chain to themselves registering /${action}" + ) if ($chained_to eq '/' . $action); + + my $children = ($self->_children_of->{ $chained_to } ||= {}); my @path_part = @{ $action->attributes->{PathPart} || [] }; @@ -231,13 +291,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() ); } @@ -245,10 +305,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; @@ -275,7 +335,9 @@ sub uri_for_action { if (my $cap = $curr->attributes->{CaptureArgs}) { return undef unless @captures >= $cap->[0]; # not enough captures if ($cap->[0]) { - unshift(@parts, splice(@captures, -$cap->[0])); + unshift(@parts, + map { s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; $_; } + splice(@captures, -$cap->[0])); } } if (my $pp = $curr->attributes->{PartPath}) { @@ -283,7 +345,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 @@ -291,9 +353,36 @@ sub uri_for_action { return undef if @captures; # fail for too many captures return join('/', '', @parts); - + +} + +=head2 $c->expand_action($action) + +Return a list of actions that represents a chained action. See +L for more info. You probably want to +use the expand_action it provides rather than this directly. + +=cut + +sub expand_action { + my ($self, $action) = @_; + + return unless $action->attributes && $action->attributes->{Chained}; + + my @chain; + my $curr = $action; + + while ($curr) { + push @chain, $curr; + my $parent = $curr->attributes->{Chained}->[0]; + $curr = $self->_actions->{$parent}; + } + + return Catalyst::ActionChain->from_chain([reverse @chain]); } +__PACKAGE__->meta->make_immutable; + =head1 USAGE =head2 Introduction