0.52
[gitmo/Class-MOP.git] / lib / Class / MOP / Attribute.pm
index 90f7d57..55b1518 100644 (file)
@@ -9,7 +9,7 @@ use Class::MOP::Method::Accessor;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 
-our $VERSION   = '0.16';
+our $VERSION   = '0.22';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -43,12 +43,12 @@ sub new {
             if ref $options{builder} || !(defined $options{builder});
         confess("Setting both default and builder is not allowed.")
             if exists $options{default};
+    } else {
+        (is_default_a_coderef(\%options))
+            || confess("References are not allowed as default values, you must ".
+                       "wrap then in a CODE reference (ex: sub { [] } and not [])")
+                if exists $options{default} && ref $options{default};
     }
-    (is_default_a_coderef(\%options))
-        || confess("References are not allowed as default values, you must ".
-                   "wrap then in a CODE reference (ex: sub { [] } and not [])")
-            if exists $options{default} && ref $options{default};
-
     bless {
         '$!name'      => $name,
         '$!accessor'  => $options{accessor},
@@ -85,20 +85,23 @@ sub initialize_instance_slot {
     my ($self, $meta_instance, $instance, $params) = @_;
     my $init_arg = $self->{'$!init_arg'};
     # try to fetch the init arg from the %params ...
-    my $val;
-    $val = $params->{$init_arg} if exists $params->{$init_arg};
+
     # if nothing was in the %params, we can use the
     # attribute's default value (if it has one)
-    if (!defined $val && defined $self->{'$!default'}) {
-        $val = $self->default($instance);
-    }
-    if (!defined $val && defined $self->{'$!builder'}) {
-        my $builder = $self->{'$!builder'};
-        confess(blessed($instance)." does not support builder method '$builder' for attribute '" . $self->name . "'")
-            unless $instance->can($builder);
-        $val = $instance->$builder;
+    if(exists $params->{$init_arg}){
+        $meta_instance->set_slot_value($instance, $self->name, $params->{$init_arg});
+    } 
+    elsif (defined $self->{'$!default'}) {
+        $meta_instance->set_slot_value($instance, $self->name, $self->default($instance));
+    } 
+    elsif (defined( my $builder = $self->{'$!builder'})) {
+        if ($builder = $instance->can($builder)) {
+            $meta_instance->set_slot_value($instance, $self->name, $instance->$builder);
+        } 
+        else {
+            confess(blessed($instance)." does not support builder method '". $self->{'$!builder'} ."' for attribute '" . $self->name . "'");
+        }
     }
-    $meta_instance->set_slot_value($instance, $self->name, $val);
 }
 
 # NOTE:
@@ -130,8 +133,45 @@ sub init_arg  { $_[0]->{'$!init_arg'}  }
 # end bootstrapped away method section.
 # (all methods below here are kept intact)
 
-sub get_read_method  { $_[0]->reader || $_[0]->accessor }
-sub get_write_method { $_[0]->writer || $_[0]->accessor }
+sub get_read_method  { 
+    my $self   = shift;    
+    my $reader = $self->reader || $self->accessor;
+    # normal case ...
+    return $reader unless ref $reader;
+    # the HASH ref case
+    my ($name) = %$reader;
+    return $name;
+}
+
+sub get_write_method { 
+    my $self   = shift;
+    my $writer = $self->writer || $self->accessor; 
+    # normal case ...
+    return $writer unless ref $writer;
+    # the HASH ref case
+    my ($name) = %$writer;
+    return $name;    
+}
+
+sub get_read_method_ref {
+    my $self = shift;
+    if ((my $reader = $self->get_read_method) && $self->associated_class) {   
+        return $self->associated_class->get_method($reader);
+    }
+    else {
+        return sub { $self->get_value(@_) };
+    }
+}
+
+sub get_write_method_ref {
+    my $self = shift;    
+    if ((my $writer = $self->get_write_method) && $self->associated_class) {         
+        return $self->associated_class->get_method($writer);
+    }
+    else {
+        return sub { $self->set_value(@_) };
+    }
+}
 
 sub is_default_a_coderef {
     ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || ''))
@@ -195,9 +235,9 @@ sub get_value {
 sub has_value {
     my ($self, $instance) = @_;
 
-    defined Class::MOP::Class->initialize(blessed($instance))
-                             ->get_meta_instance
-                             ->get_slot_value($instance, $self->name) ? 1 : 0;
+    Class::MOP::Class->initialize(blessed($instance))
+                     ->get_meta_instance
+                     ->is_slot_initialized($instance, $self->name);
 }
 
 sub clear_value {
@@ -358,12 +398,6 @@ value of C<-foo>, then the following code will Just Work.
 In an init_arg is not assigned, it will automatically use the
 value of C<$name>.
 
-=item I<default>
-
-The value of this key is the default value which
-C<Class::MOP::Class::construct_instance> will initialize the
-attribute to.
-
 =item I<builder>
 
 The value of this key is the name of the method that will be
@@ -371,6 +405,12 @@ called to obtain the value used to initialize the attribute.
 This should be a method in the class associated with the attribute,
 not a method in the attribute class itself.
 
+=item I<default>
+
+The value of this key is the default value which
+C<Class::MOP::Class::construct_instance> will initialize the
+attribute to.
+
 B<NOTE:>
 If the value is a simple scalar (string or number), then it can
 be just passed as is. However, if you wish to initialize it with
@@ -455,9 +495,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>
 
@@ -494,7 +544,7 @@ even to attributes with just write only accessors.
 
 =item B<has_value ($instance)>
 
-Returns a boolean indicating if the item in the C<$instance> has a value in it.
+Return a boolean indicating if the item in the C<$instance> has a value in it.
 This is basically what the default C<predicate> method calls.
 
 =item B<clear_value ($instance)>
@@ -530,22 +580,35 @@ passed into C<new>. I think they are pretty much self-explanitory.
 
 =item B<default (?$instance)>
 
-As noted in the documentation for C<new> above, if the I<default>
-value is a CODE reference, this accessor will pass a single additional
-argument C<$instance> into it and return the value.
+Return the default value for the attribute.
+
+If you pass in an C<$instance> argument to this accessor and the
+I<default> is a CODE reference, then the CODE reference will be
+executed with the C<$instance> as its argument.
 
 =item B<slots>
 
-Returns a list of slots required by the attribute. This is usually
+Return a list of slots required by the attribute. This is usually
 just one, which is the name of the attribute.
 
 =item B<get_read_method>
 
 =item B<get_write_method>
 
-Return the name of a method suitable for reading / writing the value of the
-attribute in the associated class. Suitable for use whether C<reader> and
-C<writer> or C<accessor> was used.
+Return the name of a method name suitable for reading / writing the value 
+of the attribute in the associated class. Suitable for use whether 
+C<reader> and C<writer> or C<accessor> was used.
+
+=item B<get_read_method_ref>
+
+=item B<get_write_method_ref>
+
+Return the CODE reference of a method suitable for reading / writing the 
+value of the attribute in the associated class. Suitable for use whether 
+C<reader> and C<writer> or C<accessor> was specified or not.
+
+NOTE: If not reader/writer/accessor was specified, this will use the 
+attribute get_value/set_value methods, which can be very inefficient.
 
 =back
 
@@ -569,6 +632,8 @@ These are all basic predicate methods for the values passed into C<new>.
 
 =item B<has_default>
 
+=item B<has_builder>
+
 =back
 
 =head2 Class association
@@ -671,7 +736,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>