From: Ricardo SIGNES Date: Mon, 4 Feb 2008 03:01:58 +0000 (+0000) Subject: allow an initilizer to be set for attributes X-Git-Tag: 0_53~8^2~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0ab65f99f6aadf14b5b686e6e6a1f3c14c14272e;p=gitmo%2FClass-MOP.git allow an initilizer to be set for attributes --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index e54f6ae..b5ecac0 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -337,6 +337,14 @@ 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 }, + )) +); + +Class::MOP::Attribute->meta->add_attribute( Class::MOP::Attribute->new('$!writer' => ( init_arg => 'writer', reader => { 'writer' => \&Class::MOP::Attribute::writer }, diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 8173a67..9b6aae7 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -68,6 +68,7 @@ sub new { # 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' => [], @@ -95,14 +96,29 @@ 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_slot_value($instance, $self->name, $params->{$init_arg}); + $meta_instance->_set_initial_slot_value( + $instance, + $self->name, + $params->{$init_arg}, + $self->initializer, + ); } elsif (defined $self->{'$!default'}) { - $meta_instance->set_slot_value($instance, $self->name, $self->default($instance)); + $meta_instance->_set_initial_slot_value( + $instance, + $self->name, + $self->default($instance), + $self->initializer, + ); } elsif (defined( my $builder = $self->{'$!builder'})) { if ($builder = $instance->can($builder)) { - $meta_instance->set_slot_value($instance, $self->name, $instance->$builder); + $meta_instance->_set_initial_slot_value( + $instance, + $self->name, + $instance->$builder, + $self->initializer, + ); } else { confess(blessed($instance)." does not support builder method '". $self->{'$!builder'} ."' for attribute '" . $self->name . "'"); @@ -127,6 +143,7 @@ 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'} } @@ -135,6 +152,7 @@ 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. # (all methods below here are kept intact) @@ -580,6 +598,8 @@ passed into C. I think they are pretty much self-explanitory. =item B +=item B + =item B =item B @@ -634,6 +654,8 @@ These are all basic predicate methods for the values passed into C. =item B +=item B + =item B =item B diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index a9d5a5d..9aa3f33 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -78,6 +78,20 @@ 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); +} + 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 9eb1603..322f606 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 => 56; +use Test::More tests => 58; use Test::Exception; BEGIN { @@ -34,6 +34,7 @@ BEGIN { has_builder builder has_init_arg init_arg has_default default is_default_a_coderef + has_initializer initializer slots get_value diff --git a/t/024_attribute_initializer.t b/t/024_attribute_initializer.t new file mode 100644 index 0000000..76e5834 --- /dev/null +++ b/t/024_attribute_initializer.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Scalar::Util 'blessed', 'reftype'; + +use Test::More tests => 4; + +BEGIN { + use_ok('Class::MOP'); +} + +=pod + +This checks that the initializer is used to set the initial value. + +=cut + +{ + package Foo; + use metaclass; + + Foo->meta->add_attribute('bar' => + reader => 'get_bar', + writer => 'set_bar', + initializer => sub { + my ($self, $value, $callback) = @_; + $callback->($value * 2); + }, + ); +} + +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", +); +