X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FDispatcher.pm;h=d5bb4554fc6c4d3f7793d444cc02a34326d2807d;hb=c41cfce33f5510dee4937dfaaff2fd331130a84b;hp=69068fbf60ee9d26e6819044496eb9853d0b9ec0;hpb=076bfad34f09c72325edd07728137d9a018f3433;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 69068fb..d5bb455 100644
--- 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;
@@ -14,23 +15,34 @@ use Tree::Simple;
 use Tree::Simple::Visitor::FindByPath;
 use Scalar::Util ();
 
-#do these belong as package vars or should we build these via a builder method?
+# Refactoring note:
+# do these belong as package vars or should we build these via a builder method?
+# See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
+
 # Preload these action types
 our @PRELOAD = qw/Index Path Regex/;
 
 # Postload these action types
 our @POSTLOAD = qw/Default/;
 
+# Note - see back-compat methods at end of file.
 has _tree => (is => 'rw');
 has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
-has _action_container_class => (is => 'rw', default => 'Catalyst::ActionContainer');
+has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
+has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
 
 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
-has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
+
+# Wrap accessors so you can assign a list and it will capture a list ref.
+around qw/preload_dispatch_types postload_dispatch_types/ => sub {
+    my $orig = shift;
+    my $self = shift;
+    return $self->$orig([@_]) if (scalar @_ && ref $_[0] ne 'ARRAY');
+    return $self->$orig(@_);
+};
 
 no Moose;
 
@@ -84,18 +96,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 +145,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 +182,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 +232,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 ) = @_;
 
@@ -490,7 +511,8 @@ sub register {
         next if $key eq 'Private';
         my $class = "Catalyst::DispatchType::$key";
         unless ( $registered->{$class} ) {
-            #some error checking rethrowing here wouldn't hurt.
+            # FIXME - Some error checking and re-throwing needed here, as
+            #         we eat exceptions loading dispatch types.
             eval { Class::MOP::load_class($class) };
             push( @{ $self->_dispatch_types }, $class->new ) unless $@;
             $registered->{$class} = 1;
@@ -617,6 +639,45 @@ sub _load_dispatch_types {
     return @loaded;
 }
 
+use Moose;
+
+# 5.70 backwards compatibility hacks.
+
+# Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
+# need the methods here which *should* be private..
+
+# However we can't really take them away until there is a sane API for
+# building actions and configuring / introspecting the dispatcher.
+# In 5.90, we should build that infrastructure, port the plugins which
+# use it, and then take the crap below away.
+# See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
+
+# Alias _method_name to method_name, add a before modifier to warn..
+foreach my $public_method_name (qw/ 
+        tree 
+        dispatch_types 
+        registered_dispatch_types 
+        method_action_class  
+        action_hash 
+        container_hash
+    /) {
+    my $private_method_name = '_' . $public_method_name;
+    my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
+    $meta->add_method($public_method_name, $meta->get_method($private_method_name));
+    {
+        my %package_hash; # Only warn once per method, per package. These are infrequent enough that
+                          # I haven't provided a way to disable them, patches welcome.
+        $meta->add_before_method_modifier($public_method_name, sub {
+            my $class = Scalar::Util::blessed(shift);
+            $package_hash{$class}++ || do { 
+                warn("Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,\n"
+                    . "this will be removed in Catalyst 5.9X");
+            };
+        });
+    }
+}
+# End 5.70 backwards compatibility hacks.
+
 no Moose;
 __PACKAGE__->meta->make_immutable;