);
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 },
# 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' => [],
# 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 . "'");
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 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)
=item B<clearer>
+=item B<initializer>
+
=item B<init_arg>
=item B<is_default_a_coderef>
=item B<has_clearer>
+=item B<has_initializer>
+
=item B<has_init_arg>
=item B<has_default>
$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);
--- /dev/null
+#!/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",
+);
+