From: Stevan Little Date: Fri, 3 Feb 2006 22:42:06 +0000 (+0000) Subject: Adding better attribute/method metaclass handling X-Git-Tag: 0_06~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=351bd7d4e81d6a359feac9b128bd975e06668990;p=gitmo%2FClass-MOP.git Adding better attribute/method metaclass handling --- diff --git a/Changes b/Changes index 1a4f6c7..b77ba21 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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',