bump version to 0.62

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

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index b454640..28e9ad3 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -7,10 +7,11 @@ use warnings;
 use Scalar::Util 'blessed', 'weaken';
 use overload     ();
 
-our $VERSION   = '0.57';
+our $VERSION   = '0.62';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
+use Moose::Meta::Method::Delegation;
 use Moose::Util ();
 use Moose::Util::TypeConstraints ();
 
@@ -60,7 +61,7 @@ sub does {
         Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
     };
     return 0 if !defined($name); # failed to load class
-    return Moose::Object::does($self, $name);
+    return $self->Moose::Object::does($name);
 }
 
 sub throw_error {
@@ -69,7 +70,8 @@ sub throw_error {
     unshift @_, "message" if @_ % 2 == 1;
     unshift @_, attr => $self if ref $self;
     unshift @_, $class;
-    goto $class->can("throw_error"); # to avoid incrementing depth by 1
+    my $handler = $class->can("throw_error"); # to avoid incrementing depth by 1
+    goto $handler;
 }
 
 sub new {
@@ -521,7 +523,7 @@ sub get_value {
                 $value = $type_constraint->coerce($value)
                     if ($self->should_coerce);
                 $type_constraint->check($value) 
-                  || c$self->throw_error("Attribute (" . $self->name
+                  || $self->throw_error("Attribute (" . $self->name
                       . ") does not pass the type constraint because: "
                       . $type_constraint->get_message($value), type_constraint => $type_constraint, data => $value);
             }
@@ -565,6 +567,13 @@ sub install_accessors {
     return;
 }
 
+sub remove_accessors {
+    my $self = shift;
+    $self->SUPER::remove_accessors(@_);
+    $self->remove_delegation if $self->has_handles;
+    return;
+}
+
 sub install_delegation {
     my $self = shift;
 
@@ -575,8 +584,6 @@ sub install_delegation {
     # to delagate to, see that method for details
     my %handles = $self->_canonicalize_handles;
 
-    # find the accessor method for this attribute
-    my $accessor = $self->_get_delegate_accessor;
 
     # install the delegation ...
     my $associated_class = $self->associated_class;
@@ -598,44 +605,23 @@ sub install_delegation {
         #cluck("Not delegating method '$handle' because it is a core method") and
         next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
 
-        if ('CODE' eq ref($method_to_call)) {
-            $associated_class->add_method($handle => Class::MOP::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 => Class::MOP::subname($name, sub {
-                my $instance = shift;
-                my $proxy = $instance->$accessor();
-                (defined $proxy) 
-                    || $self->throw_error("Cannot delegate $handle to $method_to_call because " . 
-                              "the value of " . $self->name . " is not defined", method_name => $method_to_call, object => $instance);
-                $proxy->$method_to_call(@_);
-            }));
-        }
+        my $method = $self->_make_delegation_method($handle, $method_to_call);
+
+        $self->associated_class->add_method($method->name, $method);
     }    
 }
 
-# private methods to help delegation ...
-
-sub _get_delegate_accessor {
+sub remove_delegation {
     my $self = shift;
-    # find the accessor method for this attribute
-    my $accessor = $self->get_read_method_ref;
-    # then unpack it if we need too ...
-    $accessor = $accessor->body if blessed $accessor;    
-    # return the accessor
-    return $accessor;
+    my %handles = $self->_canonicalize_handles;
+    my $associated_class = $self->associated_class;
+    foreach my $handle (keys %handles) {
+        $self->associated_class->remove_method($handle);
+    }
 }
 
+# private methods to help delegation ...
+
 sub _canonicalize_handles {
     my $self    = shift;
     my $handles = $self->handles;
@@ -660,6 +646,9 @@ sub _canonicalize_handles {
         }
     }
     else {
+        Class::MOP::load_class($handles) 
+            unless Class::MOP::is_class_loaded($handles);
+            
         my $role_meta = eval { $handles->meta };
         if ($@) {
             $self->throw_error("Unable to canonicalize the 'handles' option with $handles because : $@", data => $handles, error => $@);
@@ -667,7 +656,7 @@ sub _canonicalize_handles {
 
         (blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
             || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role", data => $handles);
-
+            
         return map { $_ => $_ } (
             $role_meta->get_method_list,
             $role_meta->get_required_method_list
@@ -713,6 +702,22 @@ sub _get_delegate_method_list {
     }
 }
 
+sub _make_delegation_method {
+    my ( $self, $handle_name, $method_to_call ) = @_;
+
+    my $method_body;
+
+    $method_body = $method_to_call
+        if 'CODE' eq ref($method_to_call);
+
+    return Moose::Meta::Method::Delegation->new(
+        name               => $handle_name,
+        package_name       => $self->associated_class->name,
+        attribute          => $self,
+        delegate_to_method => $method_to_call,
+    );
+}
+
 package Moose::Meta::Attribute::Custom::Moose;
 sub register_implementation { 'Moose::Meta::Attribute' }
 
@@ -756,8 +761,12 @@ will behave just as L<Class::MOP::Attribute> does.
 
 =item B<install_accessors>
 
+=item B<remove_accessors>
+
 =item B<install_delegation>
 
+=item B<remove_delegation>
+
 =item B<accessor_metaclass>
 
 =item B<get_value>