separate arg compare from display better
John Napiorkowski [Tue, 1 Mar 2016 03:44:03 +0000 (21:44 -0600)]
lib/Catalyst/Action.pm
lib/Catalyst/Controller.pm
lib/Catalyst/DispatchType/Chained.pm
t/args-empty-parens-bug.t
t/bad_warnings.t

index 3497e21..fd4aa1c 100644 (file)
@@ -68,6 +68,10 @@ has number_of_args => (
   }
 
 sub normalized_arg_number {
+  return $_[0]->number_of_args;
+}
+
+sub comparable_arg_number {
   return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0;
 }
 
@@ -130,6 +134,7 @@ has args_constraints => (
   handles => {
     has_args_constraints => 'count',
     args_constraint_count => 'count',
+    all_args_constraints => 'elements',
   });
 
   sub _build_args_constraints {
@@ -215,6 +220,7 @@ has captures_constraints => (
   handles => {
     has_captures_constraints => 'count',
     captures_constraints_count => 'count',
+    all_captures_constraints => 'elements',
   });
 
   sub _build_captures_constraints {
@@ -381,8 +387,8 @@ sub match_args {
         # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this
         # way we can avoid calling the constraint when the arg length is incorrect.
         if(
-          $self->normalized_arg_number == ~0 ||
-          scalar( @args ) == $self->normalized_arg_number
+          $self->comparable_arg_number == ~0 ||
+          scalar( @args ) == $self->comparable_arg_number
         ) {
           return $self->args_constraints->[0]->check($args);
         } else {
@@ -397,7 +403,7 @@ sub match_args {
       } else {
         # Because of the way chaining works, we can expect args that are totally not
         # what you'd expect length wise.  When they don't match length, thats a fail
-        return 0 unless scalar( @args ) == $self->normalized_arg_number;
+        return 0 unless scalar( @args ) == $self->comparable_arg_number;
 
         for my $i(0..$#args) {
           $self->args_constraints->[$i]->check($args[$i]) || return 0;
@@ -406,10 +412,10 @@ sub match_args {
       }
     } else {
       # If infinite args with no constraints, we always match
-      return 1 if $self->normalized_arg_number == ~0;
+      return 1 if $self->comparable_arg_number == ~0;
 
       # Otherwise, we just need to match the number of args.
-      return scalar( @args ) == $self->normalized_arg_number;
+      return scalar( @args ) == $self->comparable_arg_number;
     }
 }
 
@@ -451,7 +457,7 @@ sub match_captures_constraints {
 
 sub compare {
     my ($a1, $a2) = @_;
-    return $a1->normalized_arg_number <=> $a2->normalized_arg_number;
+    return $a1->comparable_arg_number <=> $a2->comparable_arg_number;
 }
 
 sub scheme {
@@ -554,6 +560,12 @@ take any arguments and undef if it will take any number of arguments.
 
 =head2 normalized_arg_number
 
+The number of arguments (starting with zero) that the current action defines, or
+undefined if there is not defined number of args (which is later treated as, "
+as many arguments as you like").
+
+=head2 comparable_arg_number
+
 For the purposes of comparison we normalize 'number_of_args' so that if it is
 undef we mean ~0 (as many args are we can think of).
 
index a30ae14..ad88a51 100644 (file)
@@ -924,6 +924,10 @@ wish to reuse over many actions.
 
 See L<Catalyst::RouteMatching> for more.
 
+B<Note>: It is highly recommended to use L<Type::Tiny> for your type constraints over
+other options.  L<Type::Tiny> exposed a better meta data interface which allows us to
+do more and better types of introspection driving tests and debugging.
+
 =head2 Consumes('...')
 
 Matches the current action against the content-type of the request.  Typically
index b74c29d..3cd15f0 100644 (file)
@@ -98,7 +98,14 @@ sub list {
                            @{ $self->_endpoints }
                   ) {
         my $args = $endpoint->list_extra_info->{Args};
-        my @parts = (defined($endpoint->attributes->{Args}[0]) ? (("*") 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);
@@ -107,7 +114,12 @@ sub list {
         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])
@@ -150,13 +162,14 @@ sub list {
             push(@rows, [ '', $name ]);
         }
 
+        my $endpoint_arg_info;
         if($endpoint->has_args_constraints) {
           my $tc = join ',', @{$endpoint->args_constraints};
-          $endpoint .= " ($tc)";
+          $endpoint_arg_info .= " ($tc)";
         } else {
-          $endpoint .= defined($endpoint->attributes->{Args}[0]) ? " ($args)" : " (...)";
+          $endpoint_arg_info .= defined($endpoint->attributes->{Args}[0]) ? " ($args)" : " (...)";
         }
-        push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : ''). ($scheme ? "$scheme: ":'')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]);
+        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;
@@ -292,7 +305,7 @@ sub recurse_match {
                     next TRY_ACTION unless $action->match($c);
                 }
                 my $args_attr = $action->attributes->{Args}->[0];
-                my $args_count = $action->normalized_arg_number;
+                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,
index 285fc6e..b485cbc 100644 (file)
@@ -19,8 +19,8 @@ use Catalyst::Test App;
 eval { App->dispatcher->dispatch_type('Chained')->list(App) };
 ok !$@, "didn't die"
     or diag "Died with: $@";
-like $TestLogger::LOGS[-1], qr{/args\s*\Q(...)\E};
-like $TestLogger::LOGS[-1], qr{/args_empty\s*\Q(...)\E};
+like $TestLogger::LOGS[-1], qr{chain_base\/args\/\.\.\.};
+like $TestLogger::LOGS[-1], qr{chain_base\/args_empty\/\.\.\.};
 
 done_testing;
 
index 2aabc28..e255a5c 100644 (file)
@@ -23,13 +23,25 @@ my $error;
   sub infinity :Chained(root) PathPart('test') Args { 
     my ($self, $c) = @_;
     $c->response->body("This is the body");
-    Test::More::is $c->action->normalized_arg_number, ~0;
+    Test::More::is $c->action->comparable_arg_number, ~0;
+  }
+
+  sub midpoint :Chained(root) PathPart('') CaptureArgs('"Int"') {
+    my ($self, $c) = @_;
+    Test::More::is $c->action->number_of_captures, 1;
+    #Test::More::is $c->action->number_of_captures_constraints, 1;
+  }
+
+  sub endpoint :Chained('midpoint') Args('"Int"') {
+    my ($self, $c) = @_;
+    Test::More::is $c->action->comparable_arg_number, 1;
+    Test::More::is $c->action->normalized_arg_number, 1;
   }
 
   sub local :Local Args {
     my ($self, $c) = @_;
     $c->response->body("This is the body");
-    Test::More::is $c->action->normalized_arg_number, ~0;
+    Test::More::is $c->action->comparable_arg_number, ~0;
   }
 
 
@@ -47,6 +59,8 @@ use Catalyst::Test 'MyApp';
 
 request GET '/root/test/a/b/c';
 request GET '/root/local/a/b/c';
+request GET '/root/11/endpoint/22';
+
 
 if($error) {
   unlike($error, qr[Argument ""Int"" isn't numeric in repeat]);
@@ -54,4 +68,4 @@ if($error) {
   ok 1;
 }
 
-done_testing(3);
+done_testing(6);