From: Stevan Little Date: Thu, 7 Feb 2008 14:28:13 +0000 (+0000) Subject: tweaking the attribute initializer stuff a little X-Git-Tag: 0_53~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8ee74136c5d5c5a6416844e7238898f47b00f553;p=gitmo%2FClass-MOP.git tweaking the attribute initializer stuff a little --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index b5ecac0..be88dc7 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -339,8 +339,8 @@ Class::MOP::Attribute->meta->add_attribute( Class::MOP::Attribute->meta->add_attribute( Class::MOP::Attribute->new('$!initializer' => ( init_arg => 'initializer', - reader => { 'initializer' => \&Class::MOP::Attribute::initializer }, - predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer }, + reader => { 'initializer' => \&Class::MOP::Attribute::initializer }, + predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer }, )) ); diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 6bc203a..0cb31c8 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -56,22 +56,22 @@ sub new { '$!name' => $name, '$!accessor' => $options{accessor}, '$!reader' => $options{reader}, - # NOTE: - # protect this from silliness - init_arg => '!............( DO NOT DO THIS )............!', - '$!writer' => $options{writer}, - '$!predicate' => $options{predicate}, - '$!clearer' => $options{clearer}, - '$!builder' => $options{builder}, - '$!init_arg' => $options{init_arg}, - '$!default' => $options{default}, + '$!writer' => $options{writer}, + '$!predicate' => $options{predicate}, + '$!clearer' => $options{clearer}, + '$!builder' => $options{builder}, + '$!init_arg' => $options{init_arg}, + '$!default' => $options{default}, + '$!initializer' => $options{initializer}, # keep a weakened link to the # class we are associated with '$!associated_class' => undef, - '$!initializer' => $options{initializer}, # and a list of the methods # associated with this attr '@!associated_methods' => [], + # NOTE: + # protect this from silliness + init_arg => '!............( DO NOT DO THIS )............!', } => $class; } @@ -96,28 +96,25 @@ sub initialize_instance_slot { # if nothing was in the %params, we can use the # attribute's default value (if it has one) if(defined $init_arg and exists $params->{$init_arg}){ - $meta_instance->_set_initial_slot_value( + $self->_set_initial_slot_value( + $meta_instance, $instance, - $self->name, $params->{$init_arg}, - $self->initializer, ); } elsif (defined $self->{'$!default'}) { - $meta_instance->_set_initial_slot_value( + $self->_set_initial_slot_value( + $meta_instance, $instance, - $self->name, $self->default($instance), - $self->initializer, ); } elsif (defined( my $builder = $self->{'$!builder'})) { if ($builder = $instance->can($builder)) { - $meta_instance->_set_initial_slot_value( + $self->_set_initial_slot_value( + $meta_instance, $instance, - $self->name, $instance->$builder, - $self->initializer, ); } else { @@ -126,6 +123,24 @@ sub initialize_instance_slot { } } +sub _set_initial_slot_value { + my ($self, $meta_instance, $instance, $value) = @_; + + my $slot_name = $self->name; + + return $meta_instance->set_slot_value($instance, $slot_name, $value) + unless $self->has_initializer; + + my $callback = sub { + $meta_instance->set_slot_value($instance, $slot_name, $_[0]); + }; + + my $initializer = $self->initializer; + + # most things will just want to set a value, so make it first arg + $instance->$initializer($value, $callback, $self); +} + # NOTE: # the next bunch of methods will get bootstrapped # away in the Class::MOP bootstrapping section @@ -135,23 +150,23 @@ sub name { $_[0]->{'$!name'} } sub associated_class { $_[0]->{'$!associated_class'} } sub associated_methods { $_[0]->{'@!associated_methods'} } -sub has_accessor { defined($_[0]->{'$!accessor'}) ? 1 : 0 } -sub has_reader { defined($_[0]->{'$!reader'}) ? 1 : 0 } -sub has_writer { defined($_[0]->{'$!writer'}) ? 1 : 0 } -sub has_predicate { defined($_[0]->{'$!predicate'}) ? 1 : 0 } -sub has_clearer { defined($_[0]->{'$!clearer'}) ? 1 : 0 } -sub has_builder { defined($_[0]->{'$!builder'}) ? 1 : 0 } -sub has_init_arg { defined($_[0]->{'$!init_arg'}) ? 1 : 0 } -sub has_default { defined($_[0]->{'$!default'}) ? 1 : 0 } +sub has_accessor { defined($_[0]->{'$!accessor'}) ? 1 : 0 } +sub has_reader { defined($_[0]->{'$!reader'}) ? 1 : 0 } +sub has_writer { defined($_[0]->{'$!writer'}) ? 1 : 0 } +sub has_predicate { defined($_[0]->{'$!predicate'}) ? 1 : 0 } +sub has_clearer { defined($_[0]->{'$!clearer'}) ? 1 : 0 } +sub has_builder { defined($_[0]->{'$!builder'}) ? 1 : 0 } +sub has_init_arg { defined($_[0]->{'$!init_arg'}) ? 1 : 0 } +sub has_default { defined($_[0]->{'$!default'}) ? 1 : 0 } sub has_initializer { defined($_[0]->{'$!initializer'}) ? 1 : 0 } -sub accessor { $_[0]->{'$!accessor'} } -sub reader { $_[0]->{'$!reader'} } -sub writer { $_[0]->{'$!writer'} } -sub predicate { $_[0]->{'$!predicate'} } -sub clearer { $_[0]->{'$!clearer'} } -sub builder { $_[0]->{'$!builder'} } -sub init_arg { $_[0]->{'$!init_arg'} } +sub accessor { $_[0]->{'$!accessor'} } +sub reader { $_[0]->{'$!reader'} } +sub writer { $_[0]->{'$!writer'} } +sub predicate { $_[0]->{'$!predicate'} } +sub clearer { $_[0]->{'$!clearer'} } +sub builder { $_[0]->{'$!builder'} } +sub init_arg { $_[0]->{'$!init_arg'} } sub initializer { $_[0]->{'$!initializer'} } # end bootstrapped away method section. @@ -242,10 +257,11 @@ sub associate_method { sub set_initial_value { my ($self, $instance, $value) = @_; - - Class::MOP::Class->initialize(blessed($instance)) - ->get_meta_instance - ->_set_initial_slot_value($instance, $self->name, $value, $self->initializer); + $self->set_initial_slot_value( + Class::MOP::Class->initialize(blessed($instance))->get_meta_instance, + $instance, + $value + ); } sub set_value { diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 8c0a73a..a9d5a5d 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -78,20 +78,6 @@ sub set_slot_value { $instance->{$slot_name} = $value; } -sub _set_initial_slot_value { - my ($self, $instance, $slot_name, $value, $initializer) = @_; - - return $self->set_slot_value($instance, $slot_name, $value) - unless $initializer; - - my $callback = sub { - $self->set_slot_value($instance, $slot_name, $_[0]); - }; - - # most things will just want to set a value, so make it first arg - $instance->$initializer($value, $callback, $self); -} - sub initialize_slot { my ($self, $instance, $slot_name) = @_; #$self->set_slot_value($instance, $slot_name, undef); diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t index 6fab683..8c8f878 100644 --- a/t/014_attribute_introspection.t +++ b/t/014_attribute_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 60; +use Test::More tests => 61; use Test::Exception; BEGIN { @@ -24,6 +24,7 @@ BEGIN { new clone initialize_instance_slot + _set_initial_slot_value name has_accessor accessor diff --git a/t/024_attribute_initializer.t b/t/024_attribute_initializer.t index db9aca5..c3cfc89 100644 --- a/t/024_attribute_initializer.t +++ b/t/024_attribute_initializer.t @@ -5,7 +5,7 @@ use warnings; use Scalar::Util 'blessed', 'reftype'; -use Test::More tests => 4; +use Test::More tests => 10; BEGIN { use_ok('Class::MOP'); @@ -22,11 +22,15 @@ This checks that the initializer is used to set the initial value. use metaclass; Foo->meta->add_attribute('bar' => - reader => 'get_bar', - writer => 'set_bar', + reader => 'get_bar', + writer => 'set_bar', initializer => sub { - my ($self, $value, $callback, $attr) = @_; - $callback->($value * 2); + my ($self, $value, $callback, $attr) = @_; + + ::isa_ok($attr, 'Class::MOP::Attribute'); + ::is($attr->name, 'bar', '... the attribute is our own'); + + $callback->($value * 2); }, ); } @@ -35,9 +39,25 @@ can_ok('Foo', 'get_bar'); can_ok('Foo', 'set_bar'); my $foo = Foo->meta->construct_instance(bar => 10); -is( - $foo->get_bar, - 20, - "initial argument was doubled as expected", -); +is($foo->get_bar, 20, "... initial argument was doubled as expected"); + +$foo->set_bar(30); + +is($foo->get_bar, 30, "... and setter works correctly"); + +# meta tests ... + +my $bar = Foo->meta->get_attribute('bar'); +isa_ok($bar, 'Class::MOP::Attribute'); + +ok($bar->has_initializer, '... bar has an initializer'); +is(reftype $bar->initializer, 'CODE', '... the initializer is a CODE ref'); + + + + + + + +