Make everything which used to inherit CAF use the MX::Emulate::CAF role + test

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Dispatcher.pm

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 694ed65..995cca5 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -2,6 +2,7 @@ package Catalyst::Dispatcher;
 
 use Moose;
 use Class::MOP;
+with 'MooseX::Emulate::Class::Accessor::Fast';
 
 use Catalyst::Exception;
 use Catalyst::Utils;
@@ -84,18 +85,6 @@ it with a C<+>, like so:
 
     +My::Dispatch::Type
 
-=head2 $self->detach( $c, $command [, \@arguments ] )
-
-Documented in L<Catalyst>
-
-=cut
-
-sub detach {
-    my ( $self, $c, $command, @args ) = @_;
-    $c->forward( $command, @args ) if $command;
-    die $Catalyst::DETACH;
-}
-
 =head2 $self->dispatch($c)
 
 Delegate the dispatch to the action that matched the url, or return a
@@ -145,8 +134,13 @@ sub _command2action {
     my $action;
 
     # go to a string path ("/foo/bar/gorch")
-    # or action object which stringifies to that
-    $action = $self->_invoke_as_path( $c, "$command", \@args );
+    # or action object
+    if (Scalar::Util::blessed($command) && $command->isa('Catalyst::Action')) {
+        $action = $command;
+    }
+    else {
+        $action = $self->_invoke_as_path( $c, "$command", \@args );
+    }
 
     # go to a component ( "MyApp::*::Foo" or $c->component("...")
     # - a path or an object)
@@ -177,7 +171,8 @@ sub _do_visit {
     my $error = qq/Couldn't $opname("$command"): /;
 
     if (!$action) {
-        $error .= qq/Invalid action or component./;
+        $error .= qq/Couldn't $opname to command "$command": /
+                 .qq/Invalid action or component./;
     }
     elsif (!defined $action->namespace) {
         $error .= qq/Action has no namespace: cannot $opname() to a plain /
@@ -226,30 +221,45 @@ Documented in L<Catalyst>
 
 sub forward {
     my $self = shift;
+    $self->_do_forward(forward => @_);
+}
+
+sub _do_forward {
+    my $self = shift;
+    my $opname = shift;
     my ( $c, $command ) = @_;
     my ( $action, $args ) = $self->_command2action(@_);
 
-    unless ($action) {
-        my $error =
-            qq/Couldn't forward to command "$command": /
-          . qq/Invalid action or component./;
+    if (!$action) {
+        my $error .= qq/Couldn't $opname to command "$command": /
+                    .qq/Invalid action or component./;
         $c->error($error);
         $c->log->debug($error) if $c->debug;
         return 0;
     }
 
-    #push @$args, @_;
-
     no warnings 'recursion';
 
     my $orig_args = $c->request->arguments();
     $c->request->arguments($args);
     $action->dispatch( $c );
     $c->request->arguments($orig_args);
-    
+
     return $c->state;
 }
 
+=head2 $self->detach( $c, $command [, \@arguments ] )
+
+Documented in L<Catalyst>
+
+=cut
+
+sub detach {
+    my ( $self, $c, $command, @args ) = @_;
+    $self->_do_forward(detach => $c, $command, @args ) if $command;
+    die $Catalyst::DETACH;
+}
+
 sub _action_rel2abs {
     my ( $self, $c, $path ) = @_;
 
@@ -357,7 +367,7 @@ sub prepare_action {
     s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
 
     $c->log->debug( 'Path is "' . $req->match . '"' )
-      if ( $c->debug && length $req->match );
+      if ( $c->debug && defined $req->match && length $req->match );
 
     $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
       if ( $c->debug && @args );