allow an initilizer to be set for attributes

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index e54f6ae..b5ecac0 100644 (file)
--- 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 (file)
--- 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<new>. I think they are pretty much self-explanitory.
 
 =item B<clearer>
 
+=item B<initializer>
+
 =item B<init_arg>
 
 =item B<is_default_a_coderef>
@@ -634,6 +654,8 @@ These are all basic predicate methods for the values passed into C<new>.
 
 =item B<has_clearer>
 
+=item B<has_initializer>
+
 =item B<has_init_arg>
 
 =item B<has_default>

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index a9d5a5d..9aa3f33 100644 (file)
--- 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 (file)
--- 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 (file)
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",
+);
+