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=8446173fd7cbb71fcd66ca1beb3f557a202d29a3;hp=399a3788c6083e9b4dacaa4b765f52170f66d450;hb=48d435ba6a0925260fd58c8c18ff425e99708eae;hpb=d21a2b27d12dd019f96f1ff1a5139728373ae779 diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 399a378..8446173 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -5,7 +5,9 @@ extends 'Catalyst::DispatchType'; use Text::SimpleTable; use Catalyst::ActionChain; +use Catalyst::Utils; use URI; +use Scalar::Util (); has _endpoints => ( is => 'rw', @@ -38,6 +40,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 ) = @_; @@ -52,7 +56,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 @@ -67,9 +80,17 @@ sub list { return unless $self->_endpoints; + my $avail_width = Catalyst::Utils::term_width() - 9; + my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50); + my $col2_width = $avail_width - $col1_width; my $paths = Text::SimpleTable->new( - [ 35, 'Path Spec' ], [ 36, 'Private' ] - ); + [ $col1_width, 'Path Spec' ], [ $col2_width, 'Private' ], + ); + + my $has_unattached_actions; + my $unattached_actions = Text::SimpleTable->new( + [ $col1_width, 'Private' ], [ $col2_width, 'Missing parent' ], + ); ENDPOINT: foreach my $endpoint ( sort { $a->reverse cmp $b->reverse } @@ -92,7 +113,11 @@ sub list { $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}"; @@ -105,11 +130,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 ) @@ -127,7 +154,13 @@ sub match { my @parts = split('/', $path); my ($chain, $captures, $parts) = $self->recurse_match($c, '/', \@parts); - push @{$request->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; @@ -202,12 +235,15 @@ sub recurse_match { local $c->req->{arguments} = [ @{$c->req->args}, @parts ]; next TRY_ACTION unless $action->match($c); } + + # Default args is blank, not 0, since Args() my $args_attr = $action->attributes->{Args}->[0]; + $args_attr = '' unless defined $args_attr; # 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 @@ -245,8 +281,13 @@ sub register { "Multiple Chained attributes not supported registering ${action}" ); } + my $chained_to = $chained_attr[0]; + + Catalyst::Exception->throw( + "Actions cannot chain to themselves registering /${action}" + ) if ($chained_to eq '/' . $action); - my $children = ($self->_children_of->{ $chained_attr[0] } ||= {}); + my $children = ($self->_children_of->{ $chained_to } ||= {}); my @path_part = @{ $action->attributes->{PathPart} || [] }; @@ -272,6 +313,23 @@ sub register { $self->_actions->{'/'.$action->reverse} = $action; + if (exists $action->attributes->{Args}) { + my $args = $action->attributes->{Args}->[0]; + if (defined($args) and not ( + Scalar::Util::looks_like_number($args) and + int($args) == $args + )) { + require Data::Dumper; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Indent = 0; + $args = Data::Dumper::Dumper($args); + Catalyst::Exception->throw( + "Invalid Args($args) for action " . $action->reverse() . + " (use 'Args' or 'Args()'" + ); + } + } + unless ($action->attributes->{CaptureArgs}) { unshift(@{ $self->_endpoints }, $action); } @@ -316,7 +374,32 @@ 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; @@ -479,7 +562,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 @@ -595,7 +678,7 @@ Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify it under +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut