Merge branch 'topic/debug_warnings'
John Napiorkowski [Mon, 4 Apr 2016 16:56:27 +0000 (11:56 -0500)]
lib/Catalyst/Action.pm
lib/Catalyst/Controller.pm
lib/Catalyst/DispatchType/Chained.pm
t/args-empty-parens-bug.t
t/bad_warnings.t [new file with mode: 0644]

index 7351f39..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 {
@@ -461,7 +467,7 @@ sub scheme {
 sub list_extra_info {
   my $self = shift;
   return {
-    Args => $self->attributes->{Args}[0],
+    Args => $self->normalized_arg_number,
     CaptureArgs => $self->number_of_captures,
   }
 } 
@@ -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;
 
diff --git a/t/bad_warnings.t b/t/bad_warnings.t
new file mode 100644 (file)
index 0000000..e255a5c
--- /dev/null
@@ -0,0 +1,71 @@
+use warnings;
+use strict;
+use Test::More;
+use HTTP::Request::Common;
+
+# In DEBUG mode, we get not a number warnigs 
+
+my $error;
+
+{
+  package MyApp::Controller::Root;
+  $INC{'MyApp/Controller/Root.pm'} = __FILE__;
+
+  use base 'Catalyst::Controller';
+
+  sub root :Chained(/) PathPrefix CaptureArgs(0) { }
+
+  sub test :Chained(root) Args('"Int"') {
+    my ($self, $c) = @_;
+    $c->response->body("This is the body");
+  }
+
+  sub infinity :Chained(root) PathPart('test') Args { 
+    my ($self, $c) = @_;
+    $c->response->body("This is the body");
+    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->comparable_arg_number, ~0;
+  }
+
+
+  package MyApp;
+  use Catalyst;
+
+  sub debug { 1 }
+
+  $SIG{__WARN__} = sub { $error = shift };
+
+  MyApp->setup;
+}
+
+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]);
+} else {
+  ok 1;
+}
+
+done_testing(6);