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=05fc51468cddb74a2d6db1b8d8b4a598fac020a3;hp=3b7b0c4cd66a4061372b97a6723f30ad74d5b6ba;hb=e72a3cd6e12d8b9594dcfdddf13c1fbabdffb900;hpb=d0a02856666b38a92f5905e86e11fd053dff91bd diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 3b7b0c4..05fc514 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -96,14 +96,16 @@ sub list { sort { $a->reverse cmp $b->reverse } @{ $self->_endpoints } ) { - my $args = $endpoint->attributes->{Args}->[0]; + my $args = $endpoint->list_extra_info->{Args}; my @parts = (defined($args) ? (("*") x $args) : '...'); my @parents = (); my $parent = "DUMMY"; + my $extra = $self->_list_extra_http_methods($endpoint); + my $consumes = $self->_list_extra_consumes($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}) { + unshift(@parts, (("*") x $cap)); } if (my $pp = $curr->attributes->{PathPart}) { unshift(@parts, $pp->[0]) @@ -121,15 +123,23 @@ 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})) { + $name .= ' ('.$cap.')'; } + if (defined(my $ct = $p->list_extra_info->{Consumes})) { + $name .= ' :'.$ct; + } + unless ($p eq $parents[0]) { $name = "-> ${name}"; } push(@rows, [ '', $name ]); } - push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]); + push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]); $rows[0][0] = join('/', '', @parts) || '/'; $paths->row(@$_) for @rows; } @@ -139,6 +149,20 @@ 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}}); +} + + =head2 $self->match( $c, $path ) Calls C to see if a chain matches the C<$path>. @@ -201,16 +225,16 @@ sub recurse_match { my @try_actions = @{$children->{$try_part}}; TRY_ACTION: foreach my $action (@try_actions) { if (my $capture_attr = $action->attributes->{CaptureArgs}) { - $capture_attr ||= 0; + my $capture_count = $capture_attr->[0] || 0; # Short-circuit if not enough remaining parts - next TRY_ACTION unless @parts >= $capture_attr->[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 if ($action->can('match_captures')) { next TRY_ACTION unless $action->match_captures($c, \@captures) } @@ -253,7 +277,7 @@ sub recurse_match { if (!$best_action || @parts < @{$best_action->{parts}} || - (!@parts && $args_attr eq 0)){ + (!@parts && defined($args_attr) && $args_attr eq "0")){ $best_action = { actions => [ $action ], captures=> [], @@ -274,6 +298,32 @@ Calls register_path for every Path attribute for the given $action. =cut +sub _check_args_attr { + my ( $self, $action, $name ) = @_; + + return unless exists $action->attributes->{$name}; + + if (@{$action->attributes->{$name}} > 1) { + Catalyst::Exception->throw( + "Multiple $name attributes not supported registering " . $action->reverse() + ); + } + my $args = $action->attributes->{$name}->[0]; + if (defined($args) and not ( + Scalar::Util::looks_like_number($args) and + int($args) == $args and $args >= 0 + )) { + require Data::Dumper; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Indent = 0; + $args = Data::Dumper::Dumper($args); + Catalyst::Exception->throw( + "Invalid $name($args) for action " . $action->reverse() . + " (use '$name' or '$name()')" + ); + } +} + sub register { my ( $self, $c, $action ) = @_; @@ -318,21 +368,15 @@ 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()'" - ); - } + foreach my $name (qw(Args CaptureArgs)) { + $self->_check_args_attr($action, $name); + } + + 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}) { @@ -674,9 +718,11 @@ 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. But if -you C out of a chain, the rest of the chain will not get called -after the C. +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