Test validity of Args attribute for Chained actions
[catagits/Catalyst-Runtime.git] / lib / Catalyst / DispatchType / Chained.pm
index b0e3f53..a29cb74 100644 (file)
@@ -7,6 +7,7 @@ use Text::SimpleTable;
 use Catalyst::ActionChain;
 use Catalyst::Utils;
 use URI;
+use Scalar::Util ();
 
 has _endpoints => (
                    is => 'rw',
@@ -151,7 +152,13 @@ sub match {
     my @parts = split('/', $path);
 
     my ($chain, $captures, $parts) = $self->recurse_match($c, '/', \@parts);
-    push @{$request->args}, @$parts if $parts && @$parts;
+
+    if ($parts && @$parts) {
+        for my $arg (@$parts) {
+            $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+            push @{$request->args}, $arg;
+        }
+    }
 
     return 0 unless $chain;
 
@@ -301,6 +308,23 @@ 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(<number>)'"
+            );
+        }
+    }
+
     unless ($action->attributes->{CaptureArgs}) {
         unshift(@{ $self->_endpoints }, $action);
     }
@@ -329,7 +353,9 @@ sub uri_for_action {
         if (my $cap = $curr->attributes->{CaptureArgs}) {
             return undef unless @captures >= $cap->[0]; # not enough captures
             if ($cap->[0]) {
-                unshift(@parts, splice(@captures, -$cap->[0]));
+                unshift(@parts,
+                    map { s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; $_; }
+                    splice(@captures, -$cap->[0]));
             }
         }
         if (my $pp = $curr->attributes->{PartPath}) {