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=3cd15f025659103d28ef92a8386a87fc517128b2;hp=5fc504ab85227c0f32f79c3bf98177c2431d7906;hb=5dd46e24eedec447bdfbc4061ed683b5a17a7b0c;hpb=e1207438ea591f9e0037fe0b2f14e072faeb6e14 diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 5fc504a..3cd15f0 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -8,6 +8,7 @@ use Catalyst::ActionChain; use Catalyst::Utils; use URI; use Scalar::Util (); +use Encode 2.21 'decode_utf8'; has _endpoints => ( is => 'rw', @@ -96,14 +97,29 @@ sub list { sort { $a->reverse cmp $b->reverse } @{ $self->_endpoints } ) { - my $args = $endpoint->attributes->{Args}->[0]; - my @parts = (defined($args) ? (("*") x $args) : '...'); + my $args = $endpoint->list_extra_info->{Args}; + + my @parts; + if($endpoint->has_args_constraints) { + @parts = map { "{$_}" } $endpoint->all_args_constraints; + } elsif(defined $endpoint->attributes->{Args}) { + @parts = (defined($endpoint->attributes->{Args}[0]) ? (("*") x $args) : '...'); + } + my @parents = (); my $parent = "DUMMY"; + my $extra = $self->_list_extra_http_methods($endpoint); + my $consumes = $self->_list_extra_consumes($endpoint); + my $scheme = $self->_list_extra_scheme($endpoint); my $curr = $endpoint; while ($curr) { - if (my $cap = $curr->attributes->{CaptureArgs}) { - unshift(@parts, (("*") x $cap->[0])); + if (my $cap = $curr->list_extra_info->{CaptureArgs}) { + if($curr->has_captures_constraints) { + my $names = join '/', map { "{$_}" } $curr->all_captures_constraints; + unshift(@parts, $names); + } else { + unshift(@parts, (("*") x $cap)); + } } if (my $pp = $curr->attributes->{PathPart}) { unshift(@parts, $pp->[0]) @@ -121,16 +137,41 @@ sub list { my @rows; foreach my $p (@parents) { my $name = "/${p}"; - if (my $cap = $p->attributes->{CaptureArgs}) { - $name .= ' ('.$cap->[0].')'; + + if (defined(my $extra = $self->_list_extra_http_methods($p))) { + $name = "${extra} ${name}"; } + if (defined(my $cap = $p->list_extra_info->{CaptureArgs})) { + if($p->has_captures_constraints) { + my $tc = join ',', @{$p->captures_constraints}; + $name .= " ($tc)"; + } else { + $name .= " ($cap)"; + } + } + if (defined(my $ct = $p->list_extra_info->{Consumes})) { + $name .= ' :'.$ct; + } + if (defined(my $s = $p->list_extra_info->{Scheme})) { + $scheme = uc $s; + } + unless ($p eq $parents[0]) { $name = "-> ${name}"; } push(@rows, [ '', $name ]); } - push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]); - $rows[0][0] = join('/', '', @parts) || '/'; + + my $endpoint_arg_info; + if($endpoint->has_args_constraints) { + my $tc = join ',', @{$endpoint->args_constraints}; + $endpoint_arg_info .= " ($tc)"; + } else { + $endpoint_arg_info .= defined($endpoint->attributes->{Args}[0]) ? " ($args)" : " (...)"; + } + push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : ''). ($scheme ? "$scheme: ":'')."/${endpoint_arg_info}". ($consumes ? " :$consumes":"" ) ]); + my @display_parts = map { $_ =~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; decode_utf8 $_ } @parts; + $rows[0][0] = join('/', '', @display_parts) || '/'; $paths->row(@$_) for @rows; } @@ -139,6 +180,25 @@ sub list { if $has_unattached_actions; } +sub _list_extra_http_methods { + my ( $self, $action ) = @_; + return unless defined $action->list_extra_info->{HTTP_METHODS}; + return join(', ', @{$action->list_extra_info->{HTTP_METHODS}}); + +} + +sub _list_extra_consumes { + my ( $self, $action ) = @_; + return unless defined $action->list_extra_info->{CONSUMES}; + return join(', ', @{$action->list_extra_info->{CONSUMES}}); +} + +sub _list_extra_scheme { + my ( $self, $action ) = @_; + return unless defined $action->list_extra_info->{Scheme}; + return uc $action->list_extra_info->{Scheme}; +} + =head2 $self->match( $c, $path ) Calls C to see if a chain matches the C<$path>. @@ -200,16 +260,22 @@ sub recurse_match { } my @try_actions = @{$children->{$try_part}}; TRY_ACTION: foreach my $action (@try_actions) { + + if (my $capture_attr = $action->attributes->{CaptureArgs}) { + my $capture_count = $action->number_of_captures|| 0; # Short-circuit if not enough remaining parts - next TRY_ACTION unless @parts >= ($capture_attr->[0]||0); + next TRY_ACTION unless @parts >= $capture_count; my @captures; my @parts = @parts; # localise # strip CaptureArgs into list - push(@captures, splice(@parts, 0, $capture_attr->[0])); + push(@captures, splice(@parts, 0, $capture_count)); + + # check if the action may fit, depending on a given test by the app + next TRY_ACTION unless $action->match_captures($c, \@captures); # try the remaining parts against children of this action my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match( @@ -239,6 +305,7 @@ sub recurse_match { next TRY_ACTION unless $action->match($c); } my $args_attr = $action->attributes->{Args}->[0]; + my $args_count = $action->comparable_arg_number; my @pathparts = split /\//, $action->attributes->{PathPart}->[0]; # No best action currently # OR This one matches with fewer parts left than the current best action, @@ -246,14 +313,29 @@ sub recurse_match { # 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 - - if (!$best_action || + if ( + !$best_action || @parts < @{$best_action->{parts}} || - (!@parts && $args_attr eq 0)){ + ( + !@parts && + defined($args_attr) && + ( + $args_count eq "0" && + ( + ($c->config->{use_chained_args_0_special_case}||0) || + ( + exists($best_action->{args_count}) && defined($best_action->{args_count}) ? + ($best_action->{args_count} ne 0) : 1 + ) + ) + ) + ) + ){ $best_action = { actions => [ $action ], captures=> [], parts => \@parts, + args_count => $args_count, n_pathparts => scalar(@pathparts), }; } @@ -308,27 +390,20 @@ sub register { ); } - $action->attributes->{PathPart} = [ $part ]; + my $encoded_part = URI->new($part)->canonical; + $encoded_part =~ s{(?<=[^/])/+\z}{}; + + $action->attributes->{PathPart} = [ $encoded_part ]; - unshift(@{ $children->{$part} ||= [] }, $action); + unshift(@{ $children->{$encoded_part} ||= [] }, $action); $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()'" - ); - } + if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) { + Catalyst::Exception->throw( + "Combining Args and CaptureArgs attributes not supported registering " . + $action->reverse() + ); } unless ($action->attributes->{CaptureArgs}) { @@ -355,11 +430,15 @@ sub uri_for_action { my @captures = @$captures; my $parent = "DUMMY"; my $curr = $action; + # If this is an action chain get the last action in the chain + if($curr->can('chain') ) { + $curr = ${$curr->chain}[-1]; + } while ($curr) { - if (my $cap = $curr->attributes->{CaptureArgs}) { - return undef unless @captures >= $cap->[0]; # not enough captures - if ($cap->[0]) { - unshift(@parts, splice(@captures, -$cap->[0])); + if (my $cap = $curr->number_of_captures) { + return undef unless @captures >= $cap; # not enough captures + if ($cap) { + unshift(@parts, splice(@captures, -$cap)); } } if (my $pp = $curr->attributes->{PathPart}) { @@ -643,6 +722,32 @@ An action that is part of a chain (that is, one that has a C<:Chained> attribute) but has no C<:CaptureArgs> attribute is treated by Catalyst as a chain end. +Allowed values for CaptureArgs is a single integer (CaptureArgs(2), meaning two +allowed) or you can declare a L, L or L +named constraint such as CaptureArgs(Int,Str) would require two args with +the first being a Integer and the second a string. You may declare your own +custom type constraints and import them into the controller namespace: + + package MyApp::Controller::Root; + + use Moose; + use MooseX::MethodAttributes; + use MyApp::Types qw/Int/; + + extends 'Catalyst::Controller'; + + sub chain_base :Chained(/) CaptureArgs(1) { } + + sub any_priority_chain :Chained(chain_base) PathPart('') Args(1) { } + + sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { } + +If you use a reference type constraint in CaptureArgs, it must be a type +like Tuple in L that allows us to determine the number of +args to match. Otherwise this will raise an error during startup. + +See L for more. + =item Args By default, endpoints receive the rest of the arguments in the path. You @@ -661,6 +766,9 @@ Just as with C<:CaptureArgs>, the arguments get passed to the action in C<@_> after the context object. They can also be reached through C<$c-Erequest-Earguments>. +You should see 'Args' in L for more details on using +type constraints in your Args declarations. + =back =head2 Auto actions, dispatching and forwarding @@ -670,12 +778,19 @@ of the endpoint of the chain, not on the chained actions way. The C actions will be run before the chain dispatching begins. In every other aspect, C actions behave as documented. -The Cing to other actions does just what you would expect. ie +The Cing to other actions does just what you would expect. i.e. only the target action is run. The actions that that action is chained to are not run. If you C out of a chain, the rest of the chain will not get called after the C. +=head2 match_captures + +A method which can optionally be implemented by actions to +stop chain matching. + +See L for further details. + =head1 AUTHORS Catalyst Contributors, see Catalyst.pm