From: Scott McWhirter <scott+github@konobi.co.uk>
Date: Thu, 25 Jun 2009 21:54:14 +0000 (+0100)
Subject: Add initial version of lazy attributes in Class::MOP
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=06a88dbb28fa425c12d6486d6e8915dbb93b9cff;p=gitmo%2FClass-MOP.git

Add initial version of lazy attributes in Class::MOP
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 67ade82..7da9660 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -481,6 +481,12 @@ Class::MOP::Attribute->meta->add_attribute(
 );
 
 Class::MOP::Attribute->meta->add_attribute(
+    Class::MOP::Attribute->new('lazy' => (
+        reader    => { 'is_lazy'     => \&Class::MOP::Attribute::is_lazy     },
+    ))
+);
+
+Class::MOP::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('default' => (
         # default has a custom 'reader' method ...
         predicate => { 'has_default' => \&Class::MOP::Attribute::has_default },
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index c58b7d8..d8806d1 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -75,6 +75,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,
@@ -101,40 +102,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 {
@@ -184,6 +201,7 @@ 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 is_lazy            { $_[0]->{'lazy'} }
 
 # end bootstrapped away method section.
 # (all methods below here are kept intact)
@@ -319,6 +337,21 @@ sub set_raw_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);
diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t
index 8eb82ce..7bf72a5 100644
--- a/t/014_attribute_introspection.t
+++ b/t/014_attribute_introspection.t
@@ -22,6 +22,7 @@ use Class::MOP;
         initialize_instance_slot
         _set_initial_slot_value
 
+        is_lazy
         name
         has_accessor      accessor
         has_writer        writer
@@ -61,6 +62,7 @@ use Class::MOP;
         install_accessors
         remove_accessors
 
+        _call_builder
         _new
         );
 
diff --git a/t/025_attribute_lazy.t b/t/025_attribute_lazy.t
new file mode 100644
index 0000000..56c88fa
--- /dev/null
+++ b/t/025_attribute_lazy.t
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+use Scalar::Util 'reftype', 'blessed';
+
+use Test::More tests => 6;
+use Test::Exception;
+
+use Class::MOP;
+use Class::MOP::Attribute;
+use Class::MOP::Method;
+
+
+{
+    package Foo;
+    use metaclass;
+
+    Foo->meta->add_attribute(
+        bar => (
+            lazy => 1,
+            default => 'haha',
+        )
+    );
+    Foo->meta->add_attribute(
+        baz => (
+            lazy => 1,
+            builder => 'buildit',
+        )
+    );
+
+    sub buildit { 'built' }
+}
+
+{
+    use Devel::Sub::Which qw(:universal);
+
+    my $obj = Foo->meta->new_object();
+    my $attrs = $obj->meta->get_attribute_map();
+
+    my $bar_attr = $attrs->{bar};
+    ok(!$bar_attr->has_value($obj), '... $attr has not had value set');
+    is($bar_attr->get_value($obj), 'haha', '... $attr value is correct');
+    ok($bar_attr->has_value($obj), '... $attr has had value set');
+
+    my $baz_attr = $attrs->{baz};
+    ok(!$baz_attr->has_value($obj), '... $attr has not had value set');
+    is($baz_attr->get_value($obj), 'built', '... $attr value is correct');
+    ok($baz_attr->has_value($obj), '... $attr has had value set');
+}
+
+
+
+