Fixed relative forwarding
Sebastian Riedel [Thu, 10 Nov 2005 12:50:00 +0000 (12:50 +0000)]
Changes
lib/Catalyst.pm
lib/Catalyst/Dispatcher.pm

diff --git a/Changes b/Changes
index 7659db8..3edcfc0 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Tis file documents the revision history for Perl extension Catalyst.
 
+5.50
+        - Fixed relative forwarding
+        - Fixed forward arrows in debug output
+
 5.49_04 2005-11-09 23:00:00
         - Made context, dispatcher, engine, request and response classes
           configurable.
index 528fbc5..4afa241 100644 (file)
@@ -843,7 +843,11 @@ sub execute {
     my ( $c, $class, $code ) = @_;
     $class = $c->components->{$class} || $class;
     $c->state(0);
-    my $callsub = ( caller(1) )[3];
+
+    my $callsub =
+        ( caller(0) )[0]->isa('Catalyst::Action')
+      ? ( caller(2) )[3]
+      : ( caller(1) )[3];
 
     my $action = '';
     if ( $c->debug ) {
index bf72cf2..8f94316 100644 (file)
@@ -80,6 +80,13 @@ sub forward {
     my $c       = shift;
     my $command = shift;
 
+    # Get the calling class
+    my $caller = ( caller(0) )[0];
+    if ( $caller->isa('Catalyst') ) {
+        if    ( ( caller(2) )[3] =~ /detach$/ )  { $caller = caller(3) }
+        elsif ( ( caller(0) )[3] =~ /forward$/ ) { $caller = caller(1) }
+    }
+
     unless ($command) {
         $c->log->debug('Nothing to forward to') if $c->debug;
         return 0;
@@ -93,8 +100,11 @@ sub forward {
         my $command_copy = $command;
 
         unless ( $command_copy =~ s/^\/// ) {
-            my $namespace = $c->stack->[-1]->namespace;
-            $command_copy = "${namespace}/${command}";
+            my $prefix =
+              Catalyst::Utils::class2prefix( $caller,
+                $c->config->{case_sensitive} )
+              || '';
+            $command_copy = "${prefix}/${command}";
         }
 
         unless ( $command_copy =~ /\// ) {