Adding better attribute/method metaclass handling

diff --git a/Changes b/Changes
index 1a4f6c7..b77ba21 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,8 +3,11 @@ Revision history for Perl extension Class-MOP.
 0.05
     * Class::MOP::Class
       - added the &attribute_metaclass and &method_metaclass
-        functions which return a metaclass name to use for 
+        attributes which contain a metaclass name to use for 
         attributes/methods respectively
+    
+    * Class::MOP
+      - bootstrap additional attributes for Class::MOP::Class 
         
     * examples/
       - adjusted the example code and tests to use the new

diff --git a/MANIFEST b/MANIFEST
index bc8ba2d..c442d2e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -22,6 +22,7 @@ t/005_attributes.t
 t/010_self_introspection.t
 t/011_create_class.t
 t/012_package_variables.t
+t/013_add_attribute_alternate.t
 t/020_attribute.t
 t/030_method.t
 t/100_BinaryTree_test.t

diff --git a/README b/README
index 48be354..d15939f 100644 (file)
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Class::MOP version 0.04
+Class::MOP version 0.05
 ===========================
 
 See the individual module documentation for more information

diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod
index d6380e3..44e279b 100644 (file)
--- a/examples/ClassEncapsulatedAttributes.pod
+++ b/examples/ClassEncapsulatedAttributes.pod
@@ -7,10 +7,17 @@ use warnings;
 
 use Class::MOP 'meta';
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use base 'Class::MOP::Class';
 
+sub initialize { 
+    (shift)->SUPER::initialize(@_, 
+        # use the custom attribute metaclass here 
+        ':attribute_metaclass' => 'ClassEncapsulatedAttributes::Attribute' 
+    );
+}
+
 sub construct_instance {
     my ($class, %params) = @_;
     my $instance = {};
@@ -38,8 +45,6 @@ sub construct_instance {
     return $instance;
 }
 
-sub attribute_metaclass { 'ClassEncapsulatedAttributes::Attribute' }
-
 package # hide the package from PAUSE
     ClassEncapsulatedAttributes::Attribute;
 

diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod
index b371c15..73b0262 100644 (file)
--- a/examples/InsideOutClass.pod
+++ b/examples/InsideOutClass.pod
@@ -34,8 +34,6 @@ sub construct_instance {
     return $instance;
 }
 
-sub attribute_metaclass { 'InsideOutClass::Attribute' }
-
 package # hide the package from PAUSE
     InsideOutClass::Attribute;
 
@@ -96,7 +94,14 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec
 
   package Foo;
   
-  sub meta { InsideOutClass->initialize($_[0]) }
+  sub meta { 
+      InsideOutClass->initialize($_[0] => (
+         # tell our metaclass to use the 
+         # InsideOut attribute metclass 
+         # to construct all it's attributes
+        ':attribute_metaclass' => 'InsideOutClass::Attribute'
+      )) 
+  }
   
   __PACKAGE__->meta->add_attribute('foo' => (
       reader => 'get_foo',

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 74d76b4..4bce07a 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -48,18 +48,32 @@ sub import {
 ## Class::MOP::Class
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('$:pkg' => (
-        init_arg => ':pkg'
+    Class::MOP::Attribute->new('$:package' => (
+        init_arg => ':package'
     ))
 );
 
 Class::MOP::Class->meta->add_attribute(
-    Class::MOP::Attribute->new('%:attrs' => (
-        init_arg => ':attrs',
+    Class::MOP::Attribute->new('%:attributes' => (
+        init_arg => ':attributes',
         default  => sub { {} }
     ))
 );
 
+Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('$:attribute_metaclass' => (
+        init_arg => ':attribute_metaclass',
+        default  => 'Class::MOP::Attribute',
+    ))
+);
+
+Class::MOP::Class->meta->add_attribute(
+    Class::MOP::Attribute->new('$:method_metaclass' => (
+        init_arg => ':method_metaclass',
+        default  => 'Class::MOP::Method',        
+    ))
+);
+
 ## Class::MOP::Attribute
 
 Class::MOP::Attribute->meta->add_attribute(Class::MOP::Attribute->new('name'));

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 6ebd6d1..7004513 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -24,11 +24,12 @@ sub meta { $_[0]->initialize($_[0]) }
     # After all, do package definitions even get reaped?
     my %METAS;
     sub initialize {
-        my ($class, $package_name) = @_;
+        my $class        = shift;
+        my $package_name = shift;
         (defined $package_name && $package_name)
             || confess "You must pass a package name";        
         return $METAS{$package_name} if exists $METAS{$package_name};
-        $METAS{$package_name} = $class->construct_class_instance($package_name);
+        $METAS{$package_name} = $class->construct_class_instance($package_name, @_);
     }
     
     # NOTE: (meta-circularity) 
@@ -38,18 +39,21 @@ sub meta { $_[0]->initialize($_[0]) }
     # class. All other classes will use the more 
     # normal &construct_instance.
     sub construct_class_instance {
-        my ($class, $package_name) = @_;
+        my $class        = shift;
+        my $package_name = shift;
         (defined $package_name && $package_name)
             || confess "You must pass a package name";    
         $class = blessed($class) || $class;
         if ($class =~ /^Class::MOP::/) {    
             bless { 
-                '$:pkg'   => $package_name, 
-                '%:attrs' => {} 
+                '$:package'             => $package_name, 
+                '%:attributes'          => {},
+                '$:attribute_metaclass' => 'Class::MOP::Attribute',
+                '$:method_metaclass'    => 'Class::MOP::Method',                
             } => $class;
         }
         else {
-            bless $class->meta->construct_instance(':pkg' => $package_name) => $class
+            bless $class->meta->construct_instance(':package' => $package_name, @_) => $class
         }
     }
 }
@@ -107,7 +111,7 @@ sub construct_instance {
 
 # Informational 
 
-sub name { $_[0]->{'$:pkg'} }
+sub name { $_[0]->{'$:package'} }
 
 sub version {  
     my $self = shift;
@@ -147,7 +151,7 @@ sub class_precedence_list {
 ## Methods
 
 # un-used right now ...
-sub method_metaclass { 'Class::MOP::Method' }
+sub method_metaclass { $_[0]->{'$:method_metaclass'} }
 
 sub add_method {
     my ($self, $method_name, $method) = @_;
@@ -269,7 +273,7 @@ sub find_all_methods_by_name {
 
 ## Attributes
 
-sub attribute_metaclass { 'Class::MOP::Attribute' }
+sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
 
 sub add_attribute {
     my $self      = shift;

diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 67ced97..218b0f5 100644 (file)
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 56;
+use Test::More tests => 60;
 use Test::Exception;
 
 BEGIN {
@@ -48,7 +48,8 @@ foreach my $non_method_name (qw(
 }
 
 foreach my $attribute_name (
-    '$:pkg', '%:attrs'
+    '$:package', '%:attributes', 
+    '$:attribute_metaclass', '$:method_metaclass'
     ) {
     ok($meta->has_attribute($attribute_name), '... Class::MOP::Class->has_attribute(' . $attribute_name . ')');        
     isa_ok($meta->get_attribute($attribute_name), 'Class::MOP::Attribute');            

diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t
index fb7581e..7aae76c 100644 (file)
--- a/t/102_InsideOutClass_test.t
+++ b/t/102_InsideOutClass_test.t
@@ -14,7 +14,11 @@ BEGIN {
 {
     package Foo;
     
-    sub meta { InsideOutClass->initialize($_[0]) }
+    sub meta { 
+        InsideOutClass->initialize($_[0] => (
+          ':attribute_metaclass' => 'InsideOutClass::Attribute'
+        )) 
+    }
     
     Foo->meta->add_attribute('foo' => (
         accessor  => 'foo',