[Catalyst-dev] $c->forward('/package/action/arg1/arg2');

[Matt S Trout]

Patch follows. Comments would be appreciated (note: just an idea, I'm not
overly attached to it but it seems kinda neat :)

=== lib/Catalyst/Dispatcher.pm
==================================================================
--- lib/Catalyst/Dispatcher.pm  (revision 2065)
+++ lib/Catalyst/Dispatcher.pm  (local)
@@ -131,10 +131,26 @@
     my $namespace = '/';
     my $arguments = ( ref( $_[-1] ) eq 'ARRAY' ) ? pop(@_) : $c->req->args;
 
+    my $results = [];
+
     if ( $command =~ /^\// ) {
-        $command =~ /^\/(.*)\/(\w+)$/;
-        $namespace = $1 || '/';
-        $command   = $2 || $command;
+        if ( $command =~ /^\/(\w+)$/ ) {
+            $results = $c->get_action( $1, $namespace );
+        }
+        else {
+            my $command_copy = $command;
+            my @extra_args;
+            DESCEND: while ( $command_copy =~ s/^\/(.*)\/(\w+)$/\/$1/ ) {
+                my $tail = $2;
+                if ( $results = $c->get_action( $tail, $1 ) ) {
+                     $command = $tail;
+                     $namespace = $command_copy;
+                     push(@{$arguments}, @extra_args);
+                     last DESCEND;
+                }
+                unshift(@extra_args, $tail);
+            }
+        }
         $command =~ s/^\///;
     }
 
@@ -142,10 +158,9 @@
         $namespace =
           Catalyst::Utils::class2prefix( $caller, $c->config->{case_sensitive} 
)
           || '/';
+        $results = $c->get_action( $command, $namespace );
     }
 
-    my $results = $c->get_action( $command, $namespace );
-
     unless ( @{$results} ) {
 
         unless ( $c->components->{$command} ) {

-- 
     Matt S Trout       Specialists in perl consulting, web development, and
  Technical Director    UNIX/Linux systems architecture and automation. Mail
Shadowcat Systems Ltd.  mst (at) shadowcatsystems.co.uk for more information

 + Help us build a better perl ORM: http://dbix-class.shadowcatsystems.co.uk/ +