separate arg compare from display better
[catagits/Catalyst-Runtime.git] / lib / Catalyst / DispatchType / Chained.pm
index 33e23d2..3cd15f0 100644 (file)
@@ -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',
@@ -97,14 +98,28 @@ sub list {
                            @{ $self->_endpoints }
                   ) {
         my $args = $endpoint->list_extra_info->{Args};
-        my @parts = (defined($args) ? (("*") x $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->list_extra_info->{CaptureArgs}) {
-                unshift(@parts, (("*") x $cap));
+                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])
@@ -127,15 +142,36 @@ sub list {
                 $name = "${extra} ${name}";
             }
             if (defined(my $cap = $p->list_extra_info->{CaptureArgs})) {
-                $name .= ' ('.$cap.')';
+                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 ? "=> " : '').($extra ? "$extra " : '')."/${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;
     }
 
@@ -148,6 +184,19 @@ 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 )
@@ -211,8 +260,10 @@ 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 = $capture_attr->[0] || 0;
+                my $capture_count = $action->number_of_captures|| 0;
 
                 # Short-circuit if not enough remaining parts
                 next TRY_ACTION unless @parts >= $capture_count;
@@ -224,7 +275,7 @@ sub recurse_match {
                 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) }
+                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(
@@ -254,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,
@@ -261,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 && defined($args_attr) && $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),
                     };
                 }
@@ -285,32 +352,6 @@ 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(<number>)')"
-        );
-    }
-}
-
 sub register {
     my ( $self, $c, $action ) = @_;
 
@@ -349,15 +390,14 @@ sub register {
         );
     }
 
-    $action->attributes->{PathPart} = [ $part ];
+    my $encoded_part = URI->new($part)->canonical;
+    $encoded_part =~ s{(?<=[^/])/+\z}{};
 
-    unshift(@{ $children->{$part} ||= [] }, $action);
+    $action->attributes->{PathPart} = [ $encoded_part ];
 
-    $self->_actions->{'/'.$action->reverse} = $action;
+    unshift(@{ $children->{$encoded_part} ||= [] }, $action);
 
-    foreach my $name (qw(Args CaptureArgs)) {
-        $self->_check_args_attr($action, $name);
-    }
+    $self->_actions->{'/'.$action->reverse} = $action;
 
     if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) {
         Catalyst::Exception->throw(
@@ -390,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]||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}) {
@@ -678,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<Moose>, L<MooseX::Types> or L<Type::Tiny>
+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<Types::Standard> that allows us to determine the number of
+args to match.  Otherwise this will raise an error during startup.
+
+See L<Catalyst::RouteMatching> for more.
+
 =item Args
 
 By default, endpoints receive the rest of the arguments in the path. You
@@ -696,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-E<gt>request-E<gt>arguments>.
 
+You should see 'Args' in L<Catalyst::Controller> for more details on using
+type constraints in your Args declarations.
+
 =back
 
 =head2 Auto actions, dispatching and forwarding