[Catalyst-commits] r7161 - in Catalyst-Runtime/5.70/trunk: . lib/Catalyst t

matthewt at dev.catalyst.perl.org matthewt at dev.catalyst.perl.org
Mon Nov 26 17:16:51 GMT 2007


Author: matthewt
Date: 2007-11-26 17:16:50 +0000 (Mon, 26 Nov 2007)
New Revision: 7161

Modified:
   Catalyst-Runtime/5.70/trunk/Changes
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm
   Catalyst-Runtime/5.70/trunk/t/unit_controller_config.t
Log:
fix __PACKAGE__->config->{foo} = 'bar' for subclassing

Modified: Catalyst-Runtime/5.70/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.70/trunk/Changes	2007-11-25 23:46:18 UTC (rev 7160)
+++ Catalyst-Runtime/5.70/trunk/Changes	2007-11-26 17:16:50 UTC (rev 7161)
@@ -1,6 +1,7 @@
 # This file documents the revision history for Perl extension Catalyst.
 
 5.7012
+        - Fix __PACKAGE__->config->{foo} = 'bar' case with subclassing
         - Add Catalyst::Stats (Jon Schutz)
         - Fixed a bug where ?q=bar=baz is decoded as q=>'bar', not 'bar=baz'.
           (Tatsuhiko Miyagawa, Masahiro Nagano)

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm	2007-11-25 23:46:18 UTC (rev 7160)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm	2007-11-26 17:16:50 UTC (rev 7161)
@@ -87,15 +87,29 @@
 
 sub config {
     my $self = shift;
-    my $config = $self->_config;
-    unless ($config) {
-        $self->_config( $config = {} );
-    }
+    my $config_sub = $self->can('_config');
+    my $config = $self->$config_sub() || {};
     if (@_) {
         my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
         $self->_config(
             $self->merge_config_hashes( $config, $newconfig )
         );
+    } else {
+        # this is a bit of a kludge, required to make
+        # __PACKAGE__->config->{foo} = 'bar';
+        # work in a subclass. Calling the Class::Data::Inheritable setter
+        # will create a new _config method in the current class if it's
+        # currently inherited from the superclass. So, the can() call will
+        # return a different subref in that case and that means we know to
+        # copy and reset the value stored in the class data.
+
+        $self->_config( $config );
+
+        if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
+
+            $config = $self->merge_config_hashes( $config, {} );
+            $self->$config_sub_now( $config );
+        }
     }
     return $config;
 }

Modified: Catalyst-Runtime/5.70/trunk/t/unit_controller_config.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/unit_controller_config.t	2007-11-25 23:46:18 UTC (rev 7160)
+++ Catalyst-Runtime/5.70/trunk/t/unit_controller_config.t	2007-11-26 17:16:50 UTC (rev 7161)
@@ -44,7 +44,7 @@
 
     use base 'base_controller';
 
-    __PACKAGE__->config( key_b => 'value_b' );
+    __PACKAGE__->config->{key_b} = 'value_b';
 }
 
 ## Okay, we expect that the base controller has a config with one key




More information about the Catalyst-commits mailing list