X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=0db5eb644d66df9e1c032078361e2b820451ce4d;hb=8cfd817729acd2f9e04c19f96d44fe305ac9cb47;hp=d456ddc5ab5d33b23b7eb6fac1d168e6dd3ba9d2;hpb=679d036571b3766c27aef4d65397e16442184063;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index d456ddc..0db5eb6 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -5,11 +5,13 @@ use strict;
 use warnings;
 
 use Class::MOP::Method::Accessor;
+use Class::MOP::Method::Reader;
+use Class::MOP::Method::Writer;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.83';
+our $VERSION   = '0.94';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -32,7 +34,7 @@ sub new {
 
     my $name = $options{name};
 
-    (defined $name && $name)
+    (defined $name)
         || confess "You must provide a name for the attribute";
 
     $options{init_arg} = $name
@@ -57,6 +59,10 @@ sub new {
 
 sub _new {
     my $class = shift;
+
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+        if $class ne __PACKAGE__;
+
     my $options = @_ == 1 ? $_[0] : {@_};
 
     bless {
@@ -71,6 +77,7 @@ sub _new {
         'default'            => $options->{default},
         'initializer'        => $options->{initializer},
         'definition_context' => $options->{definition_context},
+        'lazy'               => $options->{lazy},
         # keep a weakened link to the
         # class we are associated with
         'associated_class' => undef,
@@ -97,40 +104,56 @@ sub clone {
     return bless { %{$self}, %options } => ref($self);
 }
 
+sub _call_builder {
+    my ( $self, $instance ) = @_;
+
+    my $builder = $self->builder();
+
+    return $instance->$builder()
+        if $instance->can( $self->builder );
+
+    $self->throw_error(  blessed($instance)
+            . " does not support builder method '"
+            . $self->builder
+            . "' for attribute '"
+            . $self->name
+            . "'",
+            object => $instance,
+     );
+}
+
 sub initialize_instance_slot {
     my ($self, $meta_instance, $instance, $params) = @_;
     my $init_arg = $self->{'init_arg'};
 
+    my ($val, $value_is_set);
     # try to fetch the init arg from the %params ...
 
     # 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}){
-        $self->_set_initial_slot_value(
-            $meta_instance, 
-            $instance,
-            $params->{$init_arg},
-        );
-    } 
-    elsif (defined $self->{'default'}) {
-        $self->_set_initial_slot_value(
-            $meta_instance, 
-            $instance,
-            $self->default($instance),
-        );
-    } 
-    elsif (defined( my $builder = $self->{'builder'})) {
-        if ($builder = $instance->can($builder)) {
-            $self->_set_initial_slot_value(
-                $meta_instance, 
-                $instance,
-                $instance->$builder,
-            );
-        } 
-        else {
-            confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
+        $val = $params->{$init_arg};
+        $value_is_set = 1;
+    } else {
+         return if $self->is_lazy;
+
+        if($self->has_default){
+            $val = $self->default($instance);
+            $value_is_set = 1;
+        } elsif($self->has_builder){
+            $val = $self->_call_builder($instance);
+            $value_is_set = 1;
         }
     }
+
+    return unless $value_is_set;
+    
+    $self->_set_initial_slot_value(
+        $meta_instance,
+        $instance,
+        $val,
+    );
+
 }
 
 sub _set_initial_slot_value {
@@ -179,7 +202,8 @@ sub init_arg           { $_[0]->{'init_arg'}    }
 sub initializer        { $_[0]->{'initializer'} }
 sub definition_context { $_[0]->{'definition_context'} }
 sub insertion_order    { $_[0]->{'insertion_order'} }
-sub set_insertion_order { $_[0]->{'insertion_order'} = $_[1] }
+sub _set_insertion_order { $_[0]->{'insertion_order'} = $_[1] }
+sub is_lazy            { $_[0]->{'lazy'} }
 
 # end bootstrapped away method section.
 # (all methods below here are kept intact)
@@ -248,7 +272,9 @@ sub get_write_method_ref {
 }
 
 sub is_default_a_coderef {
-    ('CODE' eq ref($_[0]->{'default'}))
+    my ($value) = $_[0]->{'default'};
+    return unless ref($value);
+    return ref($value) eq 'CODE' || (blessed($value) && $value->isa('Class::MOP::Method'));
 }
 
 sub default {
@@ -299,7 +325,10 @@ sub set_initial_value {
     );
 }
 
-sub set_value {
+sub set_value { shift->set_raw_value(@_) }
+sub get_value { shift->get_raw_value(@_) }
+
+sub set_raw_value {
     my ($self, $instance, $value) = @_;
 
     Class::MOP::Class->initialize(ref($instance))
@@ -307,9 +336,24 @@ sub set_value {
                      ->set_slot_value($instance, $self->name, $value);
 }
 
-sub get_value {
+sub get_raw_value {
     my ($self, $instance) = @_;
 
+    if($self->is_lazy && !$self->has_value($instance)){
+        my $val;
+
+        if($self->has_default){
+            $val = $self->default($instance);
+        } elsif($self->has_builder){
+            $val = $self->_call_builder($instance);
+        }
+       
+        $self->set_initial_value(
+            $instance,
+            $val,
+        );
+    }
+
     Class::MOP::Class->initialize(ref($instance))
                      ->get_meta_instance
                      ->get_slot_value($instance, $self->name);
@@ -334,11 +378,11 @@ sub clear_value {
 ## load em up ...
 
 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
-
-sub process_accessors {
-    Carp::cluck('The process_accessors method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n");
-    shift->_process_accessors(@_);
+sub method_metaclasses {
+    {
+        reader => 'Class::MOP::Method::Reader',
+        writer => 'Class::MOP::Method::Writer',
+    }
 }
 
 sub _process_accessors {
@@ -376,7 +420,9 @@ sub _process_accessors {
                 $method_ctx->{description} = $desc;
             }
 
-            $method = $self->accessor_metaclass->new(
+            my $method_metaclass = $self->method_metaclasses->{$type} || $self->accessor_metaclass;
+
+            $method = $method_metaclass->new(
                 attribute     => $self,
                 is_inline     => $inline_me,
                 accessor_type => $type,
@@ -427,7 +473,7 @@ sub install_accessors {
         }
         my $method = $class->get_method($accessor);
         $class->remove_method($accessor)
-            if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
+            if (ref($method) && $method->isa('Class::MOP::Method::Attribute'));
     };
 
     sub remove_accessors {
@@ -591,7 +637,7 @@ twice the given value.
   Class::MOP::Attribute->new(
       'doubled' => (
           initializer => sub {
-              my ( $instance, $value, $set ) = @_;
+              my ( $self, $value, $set, $attr ) = @_;
               $set->( $value * 2 );
           },
       )
@@ -760,6 +806,11 @@ writing the attribute's value in the associated class. These methods
 always return a subroutine reference, regardless of whether or not the
 attribute is read- or write-only.
 
+=item B<< $attr->insertion_order >>
+
+If this attribute has been inserted into a class, this returns a zero
+based index regarding the order of insertion.
+
 =back
 
 =head2 Informational predicates
@@ -791,6 +842,10 @@ C<undef> is the default C<default> anyway.
 
 =item B<< $attr->has_builder >>
 
+=item B<< $attr->has_insertion_order >>
+
+This will be I<false> if this attribute has not be inserted into a class
+
 =back
 
 =head2 Value management
@@ -818,6 +873,12 @@ It's unlikely that you'll need to call this method yourself.
 Sets the value without going through the accessor. Note that this
 works even with read-only attributes.
 
+=item B<< $attr->set_raw_value($instance, $value) >>
+
+Sets the value with no side effects such as a trigger.
+
+This doesn't actually apply to Class::MOP attributes, only to subclasses.
+
 =item B<< $attr->set_initial_value($instance, $value) >>
 
 Sets the value without going through the accessor. This method is only
@@ -828,6 +889,12 @@ called when the instance is first being initialized.
 Returns the value without going through the accessor. Note that this
 works even with write-only accessors.
 
+=item B<< $sttr->get_raw_value($instance) >>
+
+Returns the value without any side effects such as lazy attributes.
+
+Doesn't actually apply to Class::MOP attributes, only to subclasses.
+
 =item B<< $attr->has_value($instance) >>
 
 Return a boolean indicating whether the attribute has been set in