From: Guillermo Roditi <groditi@gmail.com>
Date: Mon, 23 Jun 2008 21:21:04 +0000 (+0000)
Subject: config wins, groditi loses. FUCK YOU FOR SUPPORTING THAT STUPID BEHAVIOR
X-Git-Tag: 5.8000_03~90
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=46d0346ddafe8e167c679cddef9834946598e689

config wins, groditi loses. FUCK YOU FOR SUPPORTING THAT STUPID BEHAVIOR
r18428@martha (orig r7906):  groditi | 2008-06-09 18:37:44 -0400
---

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 0d51b1d..0f70e5e 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -2449,4 +2449,6 @@ the same terms as Perl itself.
 
 no Moose;
 
+__PACKAGE__->meta->make_immutable;
+
 1;
diff --git a/lib/Catalyst/AttrContainer.pm b/lib/Catalyst/AttrContainer.pm
index 060ee59..764c460 100644
--- a/lib/Catalyst/AttrContainer.pm
+++ b/lib/Catalyst/AttrContainer.pm
@@ -2,15 +2,13 @@ package Catalyst::AttrContainer;
 
 use Moose;
 use Catalyst::Exception;
-
-with 'Catalyst::ClassData';
 use Scalar::Util 'blessed';
+with 'Catalyst::ClassData';
 
 no Moose;
 
-__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
-__PACKAGE__->_attr_cache( {} );
-__PACKAGE__->_action_cache( [] );
+__PACKAGE__->mk_classdata(_attr_cache => {} );
+__PACKAGE__->mk_classdata( _action_cache => [] );
 
 # note - see attributes(3pm)
 sub MODIFY_CODE_ATTRIBUTES {
diff --git a/lib/Catalyst/ClassData.pm b/lib/Catalyst/ClassData.pm
index b4eecbe..e7379d1 100644
--- a/lib/Catalyst/ClassData.pm
+++ b/lib/Catalyst/ClassData.pm
@@ -11,15 +11,20 @@ sub mk_classdata {
 
   my $slot = '$'.$attribute;
   my $accessor =  sub {
+    my $meta = $_[0]->meta;
     if(@_ > 1){
-      $_[0]->meta->add_package_symbol($slot, \ $_[1]);
+      $meta->add_package_symbol($slot, \ $_[1]);
       return $_[1];
     }
 
-    foreach my $super ( (blessed $_[0] || $_[0]), $_[0]->meta->linearized_isa ) {
-      my $meta = Moose::Meta::Class->initialize($super);
-      if( $meta->has_package_symbol($slot) ){
-        return ${ $meta->get_package_symbol($slot) };
+    if( $meta->has_package_symbol($slot) ){
+      return ${ $meta->get_package_symbol($slot) };
+    } else {
+      foreach my $super ( $meta->linearized_isa ) {
+        my $super_meta = Moose::Meta::Class->initialize($super);
+        if( $super_meta->has_package_symbol($slot) ){
+          return ${ $super_meta->get_package_symbol($slot) };
+        }
       }
     }
     return;
@@ -39,3 +44,26 @@ sub mk_classdata {
 1;
 
 __END__
+
+
+=head1 NAME
+
+Catalyst::ClassData - Class data acessors
+
+=head1 METHODS
+
+=head2 mk_classdata $name, $optional_value
+
+A moose-safe clone of L<Class::Data::Inheritable> that borrows some ideas from
+L<Class::Accessor::Grouped>;
+
+=head1 AUTHOR
+
+Guillermo Roditi
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/Catalyst/Component.pm b/lib/Catalyst/Component.pm
index a66a7c2..2950f44 100644
--- a/lib/Catalyst/Component.pm
+++ b/lib/Catalyst/Component.pm
@@ -54,7 +54,7 @@ component loader with config() support and a process() method placeholder.
 
 =cut
 
-__PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
+__PACKAGE__->mk_classdata('_plugins');
 
 around new => sub {
     my ( $orig, $self) = @_;
@@ -83,15 +83,39 @@ sub COMPONENT {
 }
 
 sub config {
-    my $self = shift;
-    my $config = $self->_config ||{};
-    if (@_) {
-        my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
-        $self->_config(
-            $self->merge_config_hashes( $config, $newconfig )
-        );
+  my $self = shift;
+  my $class = blessed $self || $self;
+
+  my $config;
+  my $meta = $class->meta;
+  if( $meta->has_package_symbol('$config') ){
+      $config = ${ $meta->get_package_symbol('$config') };
+  } else {
+    foreach my $super ( $meta->linearized_isa ) {
+      my $super_meta = Moose::Meta::Class->initialize($super);
+      if( $super_meta->has_package_symbol('$config') ){
+        $config = ${ $super_meta->get_package_symbol('$config') };
+        unless( @_ ){ #don't copy and write it twice
+          $config = $class->merge_config_hashes( $config, {} );
+          $meta->add_package_symbol('$config', \ $config);
+        }
+        last;
+      }
     }
-    return $config;
+  }
+
+  unless( defined $config ){
+    $config = {};
+    $meta->add_package_symbol('$config', \ $config) unless @_;
+  }
+
+  if (@_) {
+    my $from_args = { %{@_ > 1 ? {@_} : $_[0]} };
+    my $new_config = $class->merge_config_hashes( $config, $from_args);
+    $meta->add_package_symbol('$config', \ $new_config);
+  }
+
+  return $config;
 }
 
 sub merge_config_hashes {
@@ -106,6 +130,8 @@ sub process {
           . " did not override Catalyst::Component::process" );
 }
 
+
+__PACKAGE__->meta->make_immutable;
 1;
 
 __END__
diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm
index 2e0bbba..256b2c3 100644
--- a/lib/Catalyst/Controller.pm
+++ b/lib/Catalyst/Controller.pm
@@ -361,6 +361,8 @@ sub _parse_MyAction_attr {
 
 no Moose;
 
+__PACKAGE__->meta->make_immutable;
+
 1;
 
 __END__
diff --git a/lib/Catalyst/Model.pm b/lib/Catalyst/Model.pm
index 896e3ae..4ab2ebc 100644
--- a/lib/Catalyst/Model.pm
+++ b/lib/Catalyst/Model.pm
@@ -36,4 +36,6 @@ the same terms as Perl itself.
 
 =cut
 
+__PACKAGE__->meta->make_immutable;
+
 1;
diff --git a/lib/Catalyst/View.pm b/lib/Catalyst/View.pm
index 1e580c3..a08bbbf 100644
--- a/lib/Catalyst/View.pm
+++ b/lib/Catalyst/View.pm
@@ -65,6 +65,6 @@ the same terms as Perl itself.
 =cut
 
 no Moose;
-#__PACKAGE__->meta->make_immutable();
+__PACKAGE__->meta->make_immutable();
 
 1;
diff --git a/t/unit_core_classdata.t b/t/unit_core_classdata.t
index eee3a35..6d60a96 100644
--- a/t/unit_core_classdata.t
+++ b/t/unit_core_classdata.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 use Scalar::Util qw/refaddr blessed/;
-use Test::More tests => 32;
+use Test::More tests => 37;
 
 {
   package ClassDataTest;
@@ -28,6 +28,12 @@ use Test::More tests => 32;
   my $scalarref2 = \$scalar2;
   my $coderef2 = sub { "beep" };
 
+  my $scalar3 = '300';
+  my $arrayref3 = [];
+  my $hashref3 = {};
+  my $scalarref3 = \$scalar3;
+  my $coderef3 = sub { "beep" };
+
 
 my @accessors = qw/_arrayref _hashref _scalarref _coderef _scalar/;
 ClassDataTest->mk_classdata($_) for @accessors;
@@ -82,3 +88,15 @@ is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
 is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
 is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
 is(ClassDataTest->_scalar, $scalar);
+
+ClassDataTest->_arrayref($arrayref3);
+ClassDataTest->_hashref($hashref3);
+ClassDataTest->_scalarref($scalarref3);
+ClassDataTest->_coderef($coderef3);
+ClassDataTest->_scalar($scalar3);
+
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref3));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref3));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref3));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef3));
+is(ClassDataTest->_scalar, $scalar3);