From: Stevan Little Date: Sun, 30 Apr 2006 12:57:48 +0000 (+0000) Subject: instnaces X-Git-Tag: 0_29_02~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b880e0de531a4f5f8f5247e7a6057f7b649e0aa0;p=gitmo%2FClass-MOP.git instnaces --- diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod index 284e558..0702eef 100644 --- a/examples/ArrayBasedStorage.pod +++ b/examples/ArrayBasedStorage.pod @@ -1,58 +1,5 @@ package # hide the package from PAUSE - ArrayBasedStorage::Attribute; - -use strict; -use warnings; - -use Carp 'confess'; - -our $VERSION = '0.01'; - -use base 'Class::MOP::Attribute'; - -sub generate_accessor_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - my $meta_instance = $_[0]->meta->get_meta_instance; - $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; - $meta_instance->get_slot_value($_[0], $attr_name); - }; -} - -sub generate_reader_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - confess "Cannot assign a value to a read-only accessor" if @_ > 1; - $_[0]->meta - ->get_meta_instance - ->get_slot_value($_[0], $attr_name); - }; -} - -sub generate_writer_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - $_[0]->meta - ->get_meta_instance - ->set_slot_value($_[0], $attr_name, $_[1]); - }; -} - -sub generate_predicate_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - defined $_[0]->meta - ->get_meta_instance - ->get_slot_value($_[0], $attr_name) ? 1 : 0; - }; -} - -package # hide the package from PAUSE ArrayBasedStorage::Instance; use strict; @@ -121,7 +68,6 @@ ArrayBasedStorage - An example of an Array based instance storage package Foo; use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute' ':instance_metaclass' => 'ArrayBasedStorage::Instance' ); diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod index d78ce24..0bf4db6 100644 --- a/examples/InsideOutClass.pod +++ b/examples/InsideOutClass.pod @@ -1,64 +1,11 @@ package # hide the package from PAUSE - InsideOutClass::Attribute; - -use strict; -use warnings; - -use Carp 'confess'; - -our $VERSION = '0.01'; - -use base 'Class::MOP::Attribute'; - -sub generate_accessor_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - my $meta_instance = $_[0]->meta->get_meta_instance; - $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; - $meta_instance->get_slot_value($_[0], $attr_name); - }; -} - -sub generate_reader_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - confess "Cannot assign a value to a read-only accessor" if @_ > 1; - $_[0]->meta - ->get_meta_instance - ->get_slot_value($_[0], $attr_name); - }; -} - -sub generate_writer_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - $_[0]->meta - ->get_meta_instance - ->set_slot_value($_[0], $attr_name, $_[1]); - }; -} - -sub generate_predicate_method { - my $self = shift; - my $attr_name = $self->name; - return sub { - defined $_[0]->meta - ->get_meta_instance - ->get_slot_value($_[0], $attr_name) ? 1 : 0; - }; -} - -package # hide the package from PAUSE InsideOutClass::Instance; use strict; use warnings; -our $VERSION = '0.06'; +our $VERSION = '0.01'; use Carp 'confess'; use Scalar::Util 'refaddr'; @@ -108,9 +55,6 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec package Foo; use metaclass 'Class::MOP::Class' => ( - # tell our metaclass to use the - # InsideOut attribute metclass - # to construct all it's attributes ':instance_metaclass' => 'InsideOutClass::Instance' ); diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 20e02b6..64e6d24 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -41,7 +41,12 @@ our $VERSION = '0.30'; Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('$:package' => ( - reader => 'name', + reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + 'name' => sub { (shift)->{'$:package'} } + }, init_arg => ':package', )) ); @@ -72,7 +77,12 @@ Class::MOP::Class->meta->add_attribute( Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('$:instance_metaclass' => ( - reader => 'instance_metaclass', + reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + 'instance_metaclass' => sub { (shift)->{'$:instance_metaclass'} } + }, init_arg => ':instance_metaclass', default => 'Class::MOP::Instance', )) @@ -82,13 +92,23 @@ Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->meta->add_attribute( Class::MOP::Attribute->new('name' => ( - reader => 'name' + reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + 'name' => sub { (shift)->{name} } + } )) ); Class::MOP::Attribute->meta->add_attribute( Class::MOP::Attribute->new('associated_class' => ( - reader => 'associated_class' + reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + 'associated_class' => sub { (shift)->{associated_class} } + } )) ); diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 284d2b9..cf12216 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -132,9 +132,10 @@ sub detach_from_class { sub generate_accessor_method { my $self = shift; - my $meta_instance = $self->associated_class->get_meta_instance; - my $attr_name = $self->name; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; return sub { + my $meta_instance = $meta_class->initialize(Scalar::Util::blessed($_[0]))->get_meta_instance; $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; $meta_instance->get_slot_value($_[0], $attr_name); }; @@ -142,29 +143,35 @@ sub generate_accessor_method { sub generate_reader_method { my $self = shift; - my $meta_instance = $self->associated_class->get_meta_instance; - my $attr_name = $self->name; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; return sub { confess "Cannot assign a value to a read-only accessor" if @_ > 1; - $meta_instance->get_slot_value($_[0], $attr_name); + $meta_class->initialize(Scalar::Util::blessed($_[0])) + ->get_meta_instance + ->get_slot_value($_[0], $attr_name); }; } sub generate_writer_method { my $self = shift; - my $meta_instance = $self->associated_class->get_meta_instance; - my $attr_name = $self->name; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; return sub { - $meta_instance->set_slot_value($_[0], $attr_name, $_[1]); + $meta_class->initialize(Scalar::Util::blessed($_[0])) + ->get_meta_instance + ->set_slot_value($_[0], $attr_name, $_[1]); }; } sub generate_predicate_method { my $self = shift; - my $meta_instance = $self->associated_class->get_meta_instance; - my $attr_name = $self->name; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; return sub { - defined $meta_instance->get_slot_value($_[0], $attr_name) ? 1 : 0; + defined $meta_class->initialize(Scalar::Util::blessed($_[0])) + ->get_meta_instance + ->get_slot_value($_[0], $attr_name) ? 1 : 0; }; } diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 38feb82..ddb26e9 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -100,7 +100,7 @@ foreach my $attribute_name (@attributes) { ## check the attributes themselves ok($meta->get_attribute('$:package')->has_reader, '... Class::MOP::Class $:package has a reader'); -is($meta->get_attribute('$:package')->reader, 'name', '... Class::MOP::Class $:package\'s a reader is &name'); +is(ref($meta->get_attribute('$:package')->reader), 'HASH', '... Class::MOP::Class $:package\'s a reader is { name => sub { ... } }'); ok($meta->get_attribute('$:package')->has_init_arg, '... Class::MOP::Class $:package has a init_arg'); is($meta->get_attribute('$:package')->init_arg, ':package', '... Class::MOP::Class $:package\'s a init_arg is :package'); diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t index 5a486ff..ccee85e 100644 --- a/t/102_InsideOutClass_test.t +++ b/t/102_InsideOutClass_test.t @@ -18,7 +18,6 @@ BEGIN { use warnings; use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'InsideOutClass::Attribute', ':instance_metaclass' => 'InsideOutClass::Instance' ); @@ -54,8 +53,7 @@ BEGIN { use strict; use warnings; - use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'InsideOutClass::Attribute', + use metaclass 'Class::MOP::Class' => ( ':instance_metaclass' => 'InsideOutClass::Instance' ); diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t index 689c996..faf4378 100644 --- a/t/108_ArrayBasedStorage_test.t +++ b/t/108_ArrayBasedStorage_test.t @@ -17,7 +17,6 @@ BEGIN { use strict; use warnings; use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', ':instance_metaclass' => 'ArrayBasedStorage::Instance', ); @@ -54,7 +53,6 @@ BEGIN { use strict; use warnings; use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', ':instance_metaclass' => 'ArrayBasedStorage::Instance', );