X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=4c5d571dbd1d2d6a8b8d7a703682c4ba761e196a;hb=4b7538e78407d5c3cdb60791fd8ff8a29948f14e;hp=f16d2f797abbfe3303518272068c4d494a12bafa;hpb=a05f85c1308adbbb4b60b1db95103ee2e279e1ea;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index f16d2f7..4c5d571 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -70,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 {
@@ -522,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);
             }
@@ -576,8 +577,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;
@@ -599,7 +598,7 @@ 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);
 
-        my $method = $self->_make_delegation_method($accessor, $handle, $method_to_call);
+        my $method = $self->_make_delegation_method($handle, $method_to_call);
 
         $self->associated_class->add_method($method->name, $method);
     }    
@@ -607,16 +606,6 @@ sub install_delegation {
 
 # private methods to help delegation ...
 
-sub _get_delegate_accessor {
-    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;
-}
-
 sub _canonicalize_handles {
     my $self    = shift;
     my $handles = $self->handles;
@@ -695,44 +684,18 @@ sub _get_delegate_method_list {
 }
 
 sub _make_delegation_method {
-    my ( $self, $accessor, $handle_name, $method_to_call ) = @_;
+    my ( $self, $handle_name, $method_to_call ) = @_;
 
     my $method_body;
 
-    if ( 'CODE' eq ref($method_to_call) ) {
-        $method_body = $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
-        $method_body = sub {
-            my $instance = shift;
-            my $proxy    = $instance->$accessor();
-            ( defined $proxy )
-                || $self->throw_error(
-                "Cannot delegate $handle_name to $method_to_call because "
-                    . "the value of "
-                    . $self->name
-                    . " is not defined", method_name => $method_to_call,
-                object => $instance );
-            $proxy->$method_to_call(@_);
-        };
-    }
+    $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,
-        body         => $method_body,
+        name               => $handle_name,
+        package_name       => $self->associated_class->name,
+        attribute          => $self,
+        delegate_to_method => $method_to_call,
     );
 }