- Turned action registration inside-out

diff --git a/Build.PL b/Build.PL
index 471b1b6..08b48ba 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -10,6 +10,7 @@ my $build = Module::Build->new(
         'UNIVERSAL::require'                => "0.10",
         'Class::Accessor::Fast'             => 0,
         'Class::Data::Inheritable'          => 0,
+        'Class::Inspector'                  => 0,
         'CGI::Cookie'                       => 0,
         'HTML::Entities'                    => 0,
         'HTTP::Body'                        => 0.03,

diff --git a/lib/Catalyst/AttrContainer.pm b/lib/Catalyst/AttrContainer.pm
index c7eb129..23ca0a1 100644 (file)
--- a/lib/Catalyst/AttrContainer.pm
+++ b/lib/Catalyst/AttrContainer.pm
@@ -13,8 +13,8 @@ __PACKAGE__->_action_cache( [] );
 # note - see attributes(3pm)
 sub MODIFY_CODE_ATTRIBUTES {
     my ( $class, $code, @attrs ) = @_;
-    $class->_attr_cache->{$code} = [@attrs];
-    push @{ $class->_action_cache }, [ $code, [@attrs] ];
+    $class->_attr_cache({ %{$class->_attr_cache}, $code => [@attrs] });
+    $class->_action_cache([ @{$class->_action_cache}, [ $code, [@attrs] ] ]);
     return ();
 }
 

diff --git a/lib/Catalyst/Base.pm b/lib/Catalyst/Base.pm
index 0703b5c..c7d21f6 100644 (file)
--- a/lib/Catalyst/Base.pm
+++ b/lib/Catalyst/Base.pm
@@ -4,6 +4,8 @@ use strict;
 use base qw/Catalyst::AttrContainer Class::Accessor::Fast/;
 
 use Catalyst::Exception;
+use Catalyst::Utils;
+use Class::Inspector;
 use NEXT;
 
 __PACKAGE__->mk_classdata($_) for qw/_config _dispatch_steps/;
@@ -52,6 +54,65 @@ sub _END : Private {
     return !@{ $c->error };
 }
 
+sub action_namespace {
+    my ( $self, $c ) = @_;
+    return
+        Catalyst::Utils::class2prefix(
+            ref $self, $c->config->{case_sensitive} ) || '';
+}
+
+sub register_actions {
+    my ( $self, $c ) = @_;
+    my $class = ref $self || $self;
+    my $namespace = $self->action_namespace( $c );
+    my %methods;
+    $methods{$self->can($_)} = $_ for @{Class::Inspector->methods($class)||[]};
+    foreach my $cache (@{$self->_action_cache}) {
+        my $code = $cache->[0];
+        my $method = $methods{$code};
+        next unless $method;
+        my $attrs = $self->_parse_attrs(@{$cache->[1]});
+        if ($attrs->{Private} && ( keys %$attrs > 1 ) ) {
+            $c->log->debug( 'Bad action definition "'
+                  . join( ' ', @{$cache->[1]} )
+                  . qq/" for "$class->$method"/ )
+              if $c->debug;
+            next;
+        }
+        my $reverse = $namespace ? "$namespace/$method" : $method;
+        my $action = Catalyst::Action->new(
+            {
+                name       => $method,
+                code       => $code,
+                reverse    => $reverse,
+                namespace  => $namespace,
+                class      => $class,
+                attributes => $attrs,
+            }
+        );
+        $c->dispatcher->register($c, $action);
+    }
+}
+
+sub _parse_attrs {
+    my ( $self, @attrs ) = @_;
+    my %attributes;
+    foreach my $attr (@attrs) {
+
+        # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
+
+        if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+)\s*\))?$/ ) ) {
+
+            if ( defined $value ) {
+                ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
+            }
+            push( @{ $attributes{$key} }, $value );
+        }
+    }
+    return \%attributes;
+}
+
+
 =head1 NAME
 
 Catalyst::Base - Catalyst Universal Base Class

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index ee513e7..5d92eb2 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -15,7 +15,7 @@ use Tree::Simple::Visitor::FindByPath;
 # Stringify to class
 use overload '""' => sub { return ref shift }, fallback => 1;
 
-__PACKAGE__->mk_accessors(qw/tree dispatch_types/);
+__PACKAGE__->mk_accessors(qw/tree dispatch_types registered_dispatch_types/);
 
 # Preload these action types
 our @PRELOAD = qw/Path Regex/;
@@ -82,10 +82,6 @@ sub forward {
         return 0;
     }
 
-    # Relative forwards from detach
-    my $caller = ( caller(1) )[0]->isa('Catalyst::Dispatcher')
-      && ( ( caller(2) )[3] =~ /::detach$/ ) ? caller(3) : caller(1);
-
     my $arguments = ( ref( $_[-1] ) eq 'ARRAY' ) ? pop(@_) : $c->req->args;
 
     my $result;
@@ -93,9 +89,7 @@ sub forward {
     my $command_copy = $command;
 
     unless ( $command_copy =~ s/^\/// ) {
-        my $namespace =
-          Catalyst::Utils::class2prefix( $caller, $c->config->{case_sensitive} )
-          || '';
+        my $namespace = $c->namespace;
         $command_copy = "${namespace}/${command}";
     }
 
@@ -154,6 +148,7 @@ qq/Couldn't forward to command "$command". Invalid action or component./;
     }
 
     local $c->request->{arguments} = [ @{$arguments} ];
+    local $c->{namespace} = $result->namespace;
 
     $result->execute($c);
 
@@ -270,67 +265,6 @@ sub get_containers {
     return map { $_->getNodeValue } @match;
 }
 
-=item $self->set_action( $c, $action, $code, $class, $attrs )
-
-=cut
-
-sub set_action {
-    my ( $self, $c, $method, $code, $class, $attrs ) = @_;
-
-    my $namespace =
-      Catalyst::Utils::class2prefix( $class, $c->config->{case_sensitive} )
-      || '';
-    my %attributes;
-
-    for my $attr ( @{$attrs} ) {
-
-        # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
-
-        my %initialized;
-        $initialized{ ref $_ }++ for @{ $self->dispatch_types };
-
-        if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+)\s*\))?$/ ) ) {
-
-            # Initialize types
-            my $class = "Catalyst::DispatchType::$key";
-            unless ( $initialized{$class} ) {
-                eval "require $class";
-                push( @{ $self->dispatch_types }, $class->new ) unless $@;
-                $initialized{$class}++;
-            }
-
-            if ( defined $value ) {
-                ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
-            }
-            push( @{ $attributes{$key} }, $value );
-        }
-    }
-
-    if ( $attributes{Private} && ( keys %attributes > 1 ) ) {
-        $c->log->debug( 'Bad action definition "'
-              . join( ' ', @{$attrs} )
-              . qq/" for "$class->$method"/ )
-          if $c->debug;
-        return;
-    }
-    return unless keys %attributes;
-
-    my $reverse = $namespace ? "$namespace/$method" : $method;
-
-    my $action = Catalyst::Action->new(
-        {
-            name       => $method,
-            code       => $code,
-            reverse    => $reverse,
-            namespace  => $namespace,
-            class      => $class,
-            attributes => \%attributes,
-        }
-    );
-
-    $self->register($c, $action);
-}
-
 sub register {
     my ( $self, $c, $action ) = @_;
 
@@ -365,6 +299,17 @@ sub register {
     # Set the method value
     $parent->getNodeValue->actions->{$action->name} = $action;
 
+    my $registered = $self->registered_dispatch_types;
+
+    foreach my $key (keys %{$action->attributes}) {
+            my $class = "Catalyst::DispatchType::$key";
+            unless ( $registered->{$class} ) {
+                eval "require $class";
+                push( @{ $self->dispatch_types }, $class->new ) unless $@;
+                $registered->{$class} = 1;
+            }
+    }
+
     # Pass the action to our dispatch types so they can register it if reqd.
     foreach my $type ( @{ $self->dispatch_types } ) {
         $type->register( $c, $action );
@@ -379,6 +324,7 @@ sub setup_actions {
     my ( $self, $c ) = @_;
 
     $self->dispatch_types( [] );
+    $self->registered_dispatch_types( {} );
 
     # Preload action types
     for my $type (@PRELOAD) {
@@ -387,6 +333,7 @@ sub setup_actions {
         Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
           if $@;
         push @{ $self->dispatch_types }, $class->new;
+        $self->registered_dispatch_types->{$class} = 1;
     }
 
     # We use a tree
@@ -394,37 +341,10 @@ sub setup_actions {
       Catalyst::ActionContainer->new( { part => '/', actions => {} } );
     $self->tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
 
-    for my $comp ( keys %{ $c->components } ) {
-
-        # We only setup components that inherit from Catalyst::Base
-        next unless $comp->isa('Catalyst::Base');
-
-        for my $action ( @{ Catalyst::Utils::reflect_actions($comp) } ) {
-            my ( $code, $attrs ) = @{$action};
-            my $name = '';
-            no strict 'refs';
-            my @cache = ( $comp, @{"$comp\::ISA"} );
-            my %classes;
+    $c->register_actions( $c );
 
-            while ( my $class = shift @cache ) {
-                $classes{$class}++;
-                for my $isa ( @{"$class\::ISA"} ) {
-                    next if $classes{$isa};
-                    push @cache, $isa;
-                    $classes{$isa}++;
-                }
-            }
-
-            for my $class ( keys %classes ) {
-                for my $sym ( values %{ $class . '::' } ) {
-                    if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
-                        $name = *{$sym}{NAME};
-                        $self->set_action( $c, $name, $code, $comp, $attrs );
-                        last;
-                    }
-                }
-            }
-        }
+    foreach my $comp ( values %{$c->components} ) {
+        $comp->register_actions( $c ) if $comp->can('register_actions');
     }
 
     # Postload action types