ovidsbug

[gitmo/Moose.git] / lib / Moose / Meta / Attribute.pm

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index b31a5c0..80c16cd 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -9,7 +9,7 @@ use Carp         'confess';
 use Sub::Name    'subname';
 use overload     ();
 
-our $VERSION   = '0.20';
+our $VERSION   = '0.22';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -71,6 +71,14 @@ sub clone_and_inherit_options {
         $actual_options{handles} = $options{handles};
         delete $options{handles};
     }
+    
+    # handles can only be added, not changed
+    if ($options{builder}) {
+        confess "You can only add the 'builder' option, you cannot change it"
+            if $self->has_builder;
+        $actual_options{builder} = $options{builder};
+        delete $options{builder};
+    }    
 
     # isa can be changed, but only if the
     # new type is a subtype
@@ -261,6 +269,45 @@ sub initialize_instance_slot {
 
 ## Slot management
 
+# FIXME:
+# this duplicates too much code from 
+# Class::MOP::Attribute, we need to 
+# refactor these bits eventually.
+# - SL
+sub _set_initial_slot_value {
+    my ($self, $meta_instance, $instance, $value) = @_;
+
+    my $slot_name = $self->name;
+
+    return $meta_instance->set_slot_value($instance, $slot_name, $value)
+        unless $self->has_initializer;
+
+    my ($type_constraint, $can_coerce);
+    if ($self->has_type_constraint) {
+        $type_constraint = $self->type_constraint;
+        $can_coerce      = ($self->should_coerce && $type_constraint->has_coercion);
+    }
+
+    my $callback = sub {
+        my $val = shift;
+        if ($type_constraint) {
+            $val = $type_constraint->coerce($val)
+                if $can_coerce;
+            $type_constraint->check($val)
+                || confess "Attribute (" 
+                         . $slot_name 
+                         . ") does not pass the type constraint because: " 
+                         . $type_constraint->get_message($val);            
+        }
+        $meta_instance->set_slot_value($instance, $slot_name, $val);
+    };
+    
+    my $initializer = $self->initializer;
+
+    # most things will just want to set a value, so make it first arg
+    $instance->$initializer($value, $callback, $self);
+}
+
 sub set_value {
     my ($self, $instance, $value) = @_;
 
@@ -398,13 +445,22 @@ sub install_accessors {
                 $associated_class->add_method($handle => subname $name, $method_to_call);
             }
             else {
+                # NOTE:
+                # we used to do a goto here, but the
+                # goto didn't handle failure correctly
+                # (it just returned nothing), so I took 
+                # that out. However, the more I thought
+                # about it, the less I liked it doing 
+                # the goto, and I prefered the act of 
+                # delegation being actually represented
+                # in the stack trace. 
+                # - SL
                 $associated_class->add_method($handle => subname $name, sub {
                     my $proxy = (shift)->$accessor();
-                    @_ = ($proxy, @_);
                     (defined $proxy) 
                         || confess "Cannot delegate $handle to $method_to_call because " . 
                                    "the value of " . $self->name . " is not defined";
-                    goto &{ $proxy->can($method_to_call) || return };
+                    $proxy->$method_to_call(@_);
                 });
             }
         }