From: Stevan Little Date: Mon, 1 May 2006 01:28:58 +0000 (+0000) Subject: working-on-it X-Git-Tag: 0_29_02~22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=62189f8484905d2cceec70b0a2a508a104e781d7;p=gitmo%2FClass-MOP.git working-on-it --- diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod index 8268d4c..aa174db 100644 --- a/examples/ArrayBasedStorage.pod +++ b/examples/ArrayBasedStorage.pod @@ -1,5 +1,76 @@ 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; use strict; @@ -26,6 +97,8 @@ sub create_instance { # operations on meta instance +sub get_slot_index_map { (shift)->{slot_index_map} } + sub get_all_slots { my $self = shift; return sort @{$self->{slots}}; diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index cf12216..b85a8a2 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -71,7 +71,9 @@ sub initialize_instance_slot { if (!defined $val && defined $self->{default}) { $val = $self->default($instance); } - $meta_instance->set_slot_value($instance, $self->name, $val); + $self->associated_class + ->get_meta_instance + ->set_slot_value($instance, $self->name, $val); } # NOTE: @@ -135,7 +137,7 @@ sub generate_accessor_method { 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; + 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); }; @@ -147,8 +149,7 @@ sub generate_reader_method { 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 + $meta_class->get_meta_instance ->get_slot_value($_[0], $attr_name); }; } @@ -158,8 +159,7 @@ sub generate_writer_method { my $meta_class = $self->associated_class; my $attr_name = $self->name; return sub { - $meta_class->initialize(Scalar::Util::blessed($_[0])) - ->get_meta_instance + $meta_class->get_meta_instance ->set_slot_value($_[0], $attr_name, $_[1]); }; } @@ -169,8 +169,7 @@ sub generate_predicate_method { my $meta_class = $self->associated_class; my $attr_name = $self->name; return sub { - defined $meta_class->initialize(Scalar::Util::blessed($_[0])) - ->get_meta_instance + defined $meta_class->get_meta_instance ->get_slot_value($_[0], $attr_name) ? 1 : 0; }; } diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index a95d0b8..62877fb 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -181,7 +181,6 @@ sub construct_instance { my ($class, %params) = @_; my $meta_instance = $class->get_meta_instance(); my $instance = $meta_instance->create_instance(); - $meta_instance->initialize_all_slots($instance); foreach my $attr ($class->compute_all_applicable_attributes()) { $attr->initialize_instance_slot($meta_instance, $instance, \%params); } diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t index 658930e..ffd36eb 100644 --- a/t/102_InsideOutClass_test.t +++ b/t/102_InsideOutClass_test.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 65; +use Test::More tests => 85; use File::Spec; BEGIN { @@ -173,3 +173,34 @@ is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"'); is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized'); is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); +{ + no strict 'refs'; + + ok(*{'Foo::foo'}{HASH}, '... there is a foo package variable in Foo'); + ok(*{'Foo::bar'}{HASH}, '... there is a bar package variable in Foo'); + + is(scalar(keys(%{'Foo::foo'})), 4, '... got the right number of entries for Foo::foo'); + is(scalar(keys(%{'Foo::bar'})), 4, '... got the right number of entries for Foo::bar'); + + ok(!*{'Bar::foo'}{HASH}, '... no foo package variable in Bar'); + ok(!*{'Bar::bar'}{HASH}, '... no bar package variable in Bar'); + ok(*{'Bar::baz'}{HASH}, '... there is a baz package variable in Bar'); + + is(scalar(keys(%{'Bar::foo'})), 0, '... got the right number of entries for Bar::foo'); + is(scalar(keys(%{'Bar::bar'})), 0, '... got the right number of entries for Bar::bar'); + is(scalar(keys(%{'Bar::baz'})), 2, '... got the right number of entries for Bar::baz'); + + ok(*{'Baz::bling'}{HASH}, '... there is a bar package variable in Baz'); + + is(scalar(keys(%{'Baz::bling'})), 1, '... got the right number of entries for Baz::bling'); + + ok(!*{'Bar::Baz::foo'}{HASH}, '... no foo package variable in Bar::Baz'); + ok(!*{'Bar::Baz::bar'}{HASH}, '... no bar package variable in Bar::Baz'); + ok(!*{'Bar::Baz::baz'}{HASH}, '... no baz package variable in Bar::Baz'); + ok(!*{'Bar::Baz::bling'}{HASH}, '... no bar package variable in Baz::Baz'); + + is(scalar(keys(%{'Bar::Baz::foo'})), 0, '... got the right number of entries for Bar::Baz::foo'); + is(scalar(keys(%{'Bar::Baz::bar'})), 0, '... got the right number of entries for Bar::Baz::bar'); + is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz'); + is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling'); +} \ No newline at end of file