From: Stevan Little Date: Tue, 2 May 2006 02:52:09 +0000 (+0000) Subject: yuval-wins X-Git-Tag: 0_29_02~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=43715282bcc431ac51dc795d98ab3433a9893aaa;p=gitmo%2FClass-MOP.git yuval-wins --- diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod index aa174db..1f04012 100644 --- a/examples/ArrayBasedStorage.pod +++ b/examples/ArrayBasedStorage.pod @@ -1,75 +1,4 @@ - -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 initialize_instance_slot { - my ($self, $meta_instance, $instance, $params) = @_; - my $init_arg = $self->{init_arg}; - # try to fetch the init arg from the %params ... - my $val; - $val = $params->{$init_arg} if exists $params->{$init_arg}; - # if nothing was in the %params, we can use the - # attribute's default value (if it has one) - if (!defined $val && defined $self->{default}) { - $val = $self->default($instance); - } - $meta_instance->set_slot_value($instance, $self->name, $val); -} - -sub generate_accessor_method { - my $self = shift; - 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); - }; -} - -sub generate_reader_method { - my $self = shift; - 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_class->initialize(Scalar::Util::blessed($_[0])) - ->get_meta_instance - ->get_slot_value($_[0], $attr_name); - }; -} - -sub generate_writer_method { - my $self = shift; - my $meta_class = $self->associated_class; - my $attr_name = $self->name; - return sub { - $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_class = $self->associated_class; - my $attr_name = $self->name; - return sub { - defined $meta_class->initialize(Scalar::Util::blessed($_[0])) - ->get_meta_instance - ->get_slot_value($_[0], $attr_name) ? 1 : 0; - }; -} - + package # hide the package from PAUSE ArrayBasedStorage::Instance; diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod index b0f805f..fdd1691 100644 --- a/examples/InsideOutClass.pod +++ b/examples/InsideOutClass.pod @@ -1,5 +1,78 @@ package # hide the package from PAUSE + InsideOutClass::Attribute; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use Carp 'confess'; +use Scalar::Util 'refaddr'; + +use base 'Class::MOP::Attribute'; + +sub initialize_instance_slot { + my ($self, $meta_instance, $instance, $params) = @_; + my $init_arg = $self->{init_arg}; + # try to fetch the init arg from the %params ... + my $val; + $val = $params->{$init_arg} if exists $params->{$init_arg}; + # if nothing was in the %params, we can use the + # attribute's default value (if it has one) + if (!defined $val && defined $self->{default}) { + $val = $self->default($instance); + } + $self->associated_class + ->get_meta_instance + ->set_slot_value($instance, $self->name, $val); +} + +## Method generation helpers + +sub generate_accessor_method { + my $self = shift; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; + return sub { + my $meta_instance = $meta_class->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 $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_class->get_meta_instance + ->get_slot_value($_[0], $attr_name); + }; +} + +sub generate_writer_method { + my $self = shift; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; + return sub { + $meta_class->get_meta_instance + ->set_slot_value($_[0], $attr_name, $_[1]); + }; +} + +sub generate_predicate_method { + my $self = shift; + my $meta_class = $self->associated_class; + my $attr_name = $self->name; + return sub { + defined $meta_class->get_meta_instance + ->get_slot_value($_[0], $attr_name) ? 1 : 0; + }; +} + +package # hide the package from PAUSE InsideOutClass::Instance; use strict; @@ -40,12 +113,6 @@ sub is_slot_initialized { return exists $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance} ? 1 : 0; } -sub inline_slot_access { - my ($self, $instance, $slot_name) = @_; - $slot_name =~ s/\'//g; - ('$' . $self->{meta}->name . '::' . $slot_name . '{Scalar::Util::refaddr(' . $instance . ')}'); -} - 1; __END__ @@ -61,7 +128,8 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec package Foo; use metaclass ( - ':instance_metaclass' => 'InsideOutClass::Instance' + ':attribute_metaclass' => 'InsideOutClass::Attribute', + ':instance_metaclass' => 'InsideOutClass::Instance' ); __PACKAGE__->meta->add_attribute('foo' => ( diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index c05aa2d..21c5ef8 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -71,9 +71,7 @@ sub initialize_instance_slot { if (!defined $val && defined $self->{default}) { $val = $self->default($instance); } - $self->associated_class - ->get_meta_instance - ->set_slot_value($instance, $self->name, $val); + $meta_instance->set_slot_value($instance, $self->name, $val); } # NOTE: @@ -133,82 +131,44 @@ sub detach_from_class { ## Method generation helpers sub generate_accessor_method { - my $self = shift; - #my $meta_class = $self->associated_class; - my $meta_instance = $self->associated_class->get_meta_instance; + my $self = shift; my $attr_name = $self->name; - #return sub { - # my $meta_instance = $meta_class->get_meta_instance; - # $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; - # $meta_instance->get_slot_value($_[0], $attr_name); - #}; - - my $code = "sub {\n" - . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . " if scalar(\@_) == 2;\n" - . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . "\n}"; - my $sub = eval $code; - confess "Could not eval code:\n$code\nbecause: $@" if $@; - return $sub; + return sub { + my $meta_instance = Class::MOP::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); + }; } sub generate_reader_method { my $self = shift; - #my $meta_class = $self->associated_class; - my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - #return sub { - # confess "Cannot assign a value to a read-only accessor" if @_ > 1; - # $meta_class->get_meta_instance - # ->get_slot_value($_[0], $attr_name); - #}; - - my $code = "sub {\n" - . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' . "\n" - . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . "\n}"; - my $sub = eval $code; - confess "Could not eval code:\n$code\nbecause: $@" if $@; - return $sub; + return sub { + confess "Cannot assign a value to a read-only accessor" if @_ > 1; + Class::MOP::Class->initialize(Scalar::Util::blessed($_[0])) + ->get_meta_instance + ->get_slot_value($_[0], $attr_name); + }; } sub generate_writer_method { my $self = shift; - #my $meta_class = $self->associated_class; - my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - #return sub { - # $meta_class->get_meta_instance - # ->set_slot_value($_[0], $attr_name, $_[1]); - #}; - - my $code = "sub {\n" - . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . "\n}"; - my $sub = eval $code; - confess "Could not eval code:\n$code\nbecause: $@" if $@; - return $sub; + return sub { + Class::MOP::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_class = $self->associated_class; - my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - #return sub { - # defined $meta_class->get_meta_instance - # ->get_slot_value($_[0], $attr_name) ? 1 : 0; - #}; - - my $code = "sub {\n" - . 'defined ' - . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . ' ? 1 : 0;' - . "\n}"; - my $sub = eval $code; - confess "Could not eval code:\n$code\nbecause: $@" if $@; - return $sub; + return sub { + defined Class::MOP::Class->initialize(Scalar::Util::blessed($_[0])) + ->get_meta_instance + ->get_slot_value($_[0], $attr_name) ? 1 : 0; + }; } sub process_accessors { diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t index ffd36eb..4788dfc 100644 --- a/t/102_InsideOutClass_test.t +++ b/t/102_InsideOutClass_test.t @@ -18,6 +18,7 @@ BEGIN { use warnings; use metaclass ( + ':attribute_metaclass' => 'InsideOutClass::Attribute', ':instance_metaclass' => 'InsideOutClass::Instance' ); @@ -54,7 +55,8 @@ BEGIN { use strict; use warnings; use metaclass ( - ':instance_metaclass' => 'InsideOutClass::Instance' + ':attribute_metaclass' => 'InsideOutClass::Attribute', + ':instance_metaclass' => 'InsideOutClass::Instance' ); Baz->meta->add_attribute('bling' => ( diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t index a7b24e9..17add18 100644 --- a/t/108_ArrayBasedStorage_test.t +++ b/t/108_ArrayBasedStorage_test.t @@ -17,7 +17,6 @@ BEGIN { use strict; use warnings; use metaclass ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', ':instance_metaclass' => 'ArrayBasedStorage::Instance', ); @@ -53,8 +52,7 @@ BEGIN { use strict; use warnings; - use metaclass ( - ':attribute_metaclass' => 'ArrayBasedStorage::Attribute', + use metaclass ( ':instance_metaclass' => 'ArrayBasedStorage::Instance', );