Changelog

[catagits/Catalyst-Runtime.git] / lib / Catalyst / DispatchType / Chained.pm

diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index 49fad32..2437698 100644 (file)
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -7,6 +7,7 @@ use Text::SimpleTable;
 use Catalyst::ActionChain;
 use Catalyst::Utils;
 use URI;
+use Scalar::Util ();
 
 has _endpoints => (
                    is => 'rw',
@@ -79,14 +80,16 @@ sub list {
 
     return unless $self->_endpoints;
 
-    my $column_width = Catalyst::Utils::term_width() - 35 - 9;
+    my $avail_width = Catalyst::Utils::term_width() - 9;
+    my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50);
+    my $col2_width = $avail_width - $col1_width;
     my $paths = Text::SimpleTable->new(
-       [ 35, 'Path Spec' ], [ $column_width, 'Private' ],
+        [ $col1_width, 'Path Spec' ], [ $col2_width, 'Private' ],
     );
 
     my $has_unattached_actions;
     my $unattached_actions = Text::SimpleTable->new(
-        [ 35, 'Private' ], [ 36, 'Missing parent' ],
+        [ $col1_width, 'Private' ], [ $col2_width, 'Missing parent' ],
     );
 
     ENDPOINT: foreach my $endpoint (
@@ -102,7 +105,7 @@ sub list {
             if (my $cap = $curr->attributes->{CaptureArgs}) {
                 unshift(@parts, (("*") x $cap->[0]));
             }
-            if (my $pp = $curr->attributes->{PartPath}) {
+            if (my $pp = $curr->attributes->{PathPart}) {
                 unshift(@parts, $pp->[0])
                     if (defined $pp->[0] && length $pp->[0]);
             }
@@ -112,7 +115,7 @@ sub list {
         }
         if ($parent ne '/') {
             $has_unattached_actions = 1;
-            $unattached_actions->row('/'.$parents[0]->reverse, $parent);
+            $unattached_actions->row('/' . ($parents[0] || $endpoint)->reverse, $parent);
             next ENDPOINT;
         }
         my @rows;
@@ -127,7 +130,7 @@ sub list {
             push(@rows, [ '', $name ]);
         }
         push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]);
-        $rows[0][0] = join('/', '', @parts);
+        $rows[0][0] = join('/', '', @parts) || '/';
         $paths->row(@$_) for @rows;
     }
 
@@ -151,7 +154,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;
 
@@ -194,7 +203,7 @@ sub recurse_match {
             if (my $capture_attr = $action->attributes->{CaptureArgs}) {
 
                 # Short-circuit if not enough remaining parts
-                next TRY_ACTION unless @parts >= $capture_attr->[0];
+                next TRY_ACTION unless @parts >= ($capture_attr->[0]||0);
 
                 my @captures;
                 my @parts = @parts; # localise
@@ -203,7 +212,7 @@ sub recurse_match {
                 push(@captures, splice(@parts, 0, $capture_attr->[0]));
 
                 # try the remaining parts against children of this action
-                my ($actions, $captures, $action_parts) = $self->recurse_match(
+                my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match(
                                              $c, '/'.$action->reverse, \@parts
                                            );
                 #    No best action currently
@@ -213,12 +222,15 @@ sub recurse_match {
                     (!$best_action                                 ||
                      $#$action_parts < $#{$best_action->{parts}}   ||
                      ($#$action_parts == $#{$best_action->{parts}} &&
-                      $#$captures < $#{$best_action->{captures}}))){
+                      $#$captures < $#{$best_action->{captures}} &&
+                      $n_pathparts > $best_action->{n_pathparts}))) {
+                    my @pathparts = split /\//, $action->attributes->{PathPart}->[0];
                     $best_action = {
                         actions => [ $action, @$actions ],
                         captures=> [ @captures, @$captures ],
-                        parts   => $action_parts
-                        };
+                        parts   => $action_parts,
+                        n_pathparts => scalar(@pathparts) + $n_pathparts,
+                    };
                 }
             }
             else {
@@ -227,11 +239,11 @@ sub recurse_match {
                     next TRY_ACTION unless $action->match($c);
                 }
                 my $args_attr = $action->attributes->{Args}->[0];
-
+                my @pathparts = split /\//, $action->attributes->{PathPart}->[0];
                 #    No best action currently
                 # OR This one matches with fewer parts left than the current best action,
                 #    And therefore is a better match
-                # OR No parts and this expects 0 
+                # 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
 
@@ -241,13 +253,14 @@ sub recurse_match {
                     $best_action = {
                         actions => [ $action ],
                         captures=> [],
-                        parts   => \@parts
-                    }
+                        parts   => \@parts,
+                        n_pathparts => scalar(@pathparts),
+                    };
                 }
             }
         }
     }
-    return @$best_action{qw/actions captures parts/} if $best_action;
+    return @$best_action{qw/actions captures parts n_pathparts/} if $best_action;
     return ();
 }
 
@@ -295,12 +308,29 @@ sub register {
         );
     }
 
-    $action->attributes->{PartPath} = [ $part ];
+    $action->attributes->{PathPart} = [ $part ];
 
     unshift(@{ $children->{$part} ||= [] }, $action);
 
     $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);
     }
@@ -332,7 +362,7 @@ sub uri_for_action {
                 unshift(@parts, splice(@captures, -$cap->[0]));
             }
         }
-        if (my $pp = $curr->attributes->{PartPath}) {
+        if (my $pp = $curr->attributes->{PathPart}) {
             unshift(@parts, $pp->[0])
                 if (defined($pp->[0]) && length($pp->[0]));
         }
@@ -345,12 +375,12 @@ sub uri_for_action {
     return undef if @captures; # fail for too many captures
 
     return join('/', '', @parts);
-   
+
 }
 
 =head2 $c->expand_action($action)
 
-Return a list of actions that represents a chained action. See 
+Return a list of actions that represents a chained action. See
 L<Catalyst::Dispatcher> for more info. You probably want to
 use the expand_action it provides rather than this directly.
 
@@ -374,6 +404,7 @@ sub expand_action {
 }
 
 __PACKAGE__->meta->make_immutable;
+1;
 
 =head1 USAGE
 
@@ -533,7 +564,7 @@ this debugging output:
   '-----------------------+------------------------------'
   ...
 
-Here's a more detailed specification of the attributes belonging to 
+Here's a more detailed specification of the attributes belonging to
 C<:Chained>:
 
 =head2 Attributes
@@ -649,7 +680,7 @@ Catalyst Contributors, see Catalyst.pm
 
 =head1 COPYRIGHT
 
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
 the same terms as Perl itself.
 
 =cut