tweak the initializer args, document set_initial_value

[gitmo/Class-MOP.git] / lib / Class / MOP / Attribute.pm

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index a1b35be..6bc203a 100644 (file)
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -9,7 +9,7 @@ use Class::MOP::Method::Accessor;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 
-our $VERSION   = '0.21';
+our $VERSION   = '0.23';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -49,10 +49,16 @@ sub new {
                        "wrap then in a CODE reference (ex: sub { [] } and not [])")
                 if exists $options{default} && ref $options{default};
     }
+    if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
+        confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
+    }
     bless {
         '$!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},
@@ -62,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' => [],
@@ -88,15 +95,30 @@ sub initialize_instance_slot {
 
     # if nothing was in the %params, we can use the
     # attribute's default value (if it has one)
-    if(exists $params->{$init_arg}){
-        $meta_instance->set_slot_value($instance, $self->name, $params->{$init_arg});
+    if(defined $init_arg and exists $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 . "'");
@@ -121,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'}    }
@@ -129,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)
@@ -216,6 +240,14 @@ sub associate_method {
 
 ## Slot management
 
+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);
+}
+
 sub set_value {
     my ($self, $instance, $value) = @_;
 
@@ -495,9 +527,19 @@ C<undef> value to the attribute.
 
 =item I<predicate>
 
-This is a basic test to see if the value of the attribute is not
-C<undef>. It will return true (C<1>) if the attribute's value is
-defined, and false (C<0>) otherwise.
+This is a basic test to see if any value has been set for the 
+attribute. It will return true (C<1>) if the attribute has been set 
+to any value (even C<undef>), and false (C<0>) otherwise.
+
+B<NOTE:>
+The predicate will return true even when you set an attribute's
+value to C<undef>. This behaviour has changed as of version 0.43. In 
+older versions, the predicate (erroneously) checked for attribute 
+value definedness, instead of presence as it is now.
+
+If you really want to get rid of the value, you have to define and 
+use a I<clearer> (see below).
+
 
 =item I<clearer>
 
@@ -527,6 +569,11 @@ know what you are doing.
 Set the value without going through the accessor. Note that this may be done to
 even attributes with just read only accessors.
 
+=item B<set_initial_value ($instance, $value)>
+
+This method sets the value without going through the accessor -- but it is only
+called when the instance data is first initialized.
+
 =item B<get_value ($instance)>
 
 Return the value without going through the accessor. Note that this may be done
@@ -564,6 +611,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>
@@ -618,6 +667,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>
@@ -726,7 +777,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>