[Catalyst-commits] r10920 - in Catalyst-Runtime/5.80/branches/pass_component_names/lib: . Catalyst

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2009-07-17 22:57:47 +0000 (Fri, 17 Jul 2009)
New Revision: 10920

Modified:
   Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst.pm
   Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Component.pm
   Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Controller.pm
Log:
Teach Cat to pass a _component_name into COMPONENT method, which is what ends up getting passed to the 'class' in actions. This means that actions know what controller name they are associated with, rather than knowing which concrete class the controller happens to be an instance of

Modified: Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Component.pm	2009-07-17 19:35:29 UTC (rev 10919)
+++ Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Component.pm	2009-07-17 22:57:47 UTC (rev 10920)
@@ -60,6 +60,8 @@
 __PACKAGE__->mk_classdata('_plugins');
 __PACKAGE__->mk_classdata('_config');
 
+has _component_name => ( is => 'ro' );
+
 sub BUILDARGS {
     my $class = shift;
     my $args = {};
@@ -85,19 +87,18 @@
 }
 
 sub COMPONENT {
-    my ( $self, $c ) = @_;
+    my ( $class, $c ) = @_;
 
     # Temporary fix, some components does not pass context to constructor
     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
-    if( my $next = $self->next::can ){
-      my $class = blessed $self || $self;
+    if ( my $next = $class->next::can ) {
       my ($next_package) = Class::MOP::get_code_info($next);
       warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}.\n";
       warn "This behavior can no longer be supported, and so your application is probably broken.\n";
       warn "Your linearized isa hierarchy is: " . join(', ', @{ mro::get_linear_isa($class) }) . "\n";
       warn "Please see perldoc Catalyst::Upgrading for more information about this issue.\n";
     }
-    return $self->new($c, $arguments);
+    return $class->new($c, $arguments);
 }
 
 sub config {

Modified: Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Controller.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Controller.pm	2009-07-17 19:35:29 UTC (rev 10919)
+++ Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst/Controller.pm	2009-07-17 22:57:47 UTC (rev 10920)
@@ -156,7 +156,7 @@
         }
     }
 
-    my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
+    my $namespace = Catalyst::Utils::class2prefix(ref($self) ? $self->_component_name : $self, $case_s) || '';
     $self->$orig($namespace) if ref($self);
     return $namespace;
 };
@@ -190,7 +190,7 @@
         @methods,
         map {
             $meta->find_method_by_name($_)
-              || confess( 'Action "' 
+              || confess( 'Action "'
                   . $_
                   . '" is not available from controller '
                   . ( ref $self ) )
@@ -207,7 +207,7 @@
 
 sub register_action_methods {
     my ( $self, $c, @methods ) = @_;
-    my $class = ref $self || $self;
+    my $class = blessed($self) ? $self->_component_name : $self;
     #this is still not correct for some reason.
     my $namespace = $self->action_namespace($c);
 

Modified: Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst.pm	2009-07-17 19:35:29 UTC (rev 10919)
+++ Catalyst-Runtime/5.80/branches/pass_component_names/lib/Catalyst.pm	2009-07-17 22:57:47 UTC (rev 10920)
@@ -2216,7 +2216,10 @@
 
     my $suffix = Catalyst::Utils::class2classsuffix( $component );
     my $config = $class->config->{ $suffix } || {};
-
+    $config->{_component_name} = $component; # Put this in args here, rather
+                                             # than in COMPONENT as there
+                                             # are lots of custom COMPONENT
+                                             # methods..
     my $instance = eval { $component->COMPONENT( $class, $config ); };
 
     if ( my $error = $@ ) {