From: Dave Rolsky Date: Mon, 15 Sep 2008 15:40:16 +0000 (+0000) Subject: Move the generation of delegation methods into MM::Method::Delegation itself. X-Git-Tag: 0.58~34^2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=46f7e6a545f17def944b291b05cd5c725bdacead;p=gitmo%2FMoose.git Move the generation of delegation methods into MM::Method::Delegation itself. --- diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index f16d2f7..09c6ce1 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -576,8 +576,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 +597,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 +605,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 +683,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, ); } diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm index 49449ce..e37a235 100644 --- a/lib/Moose/Meta/Method/Delegation.pm +++ b/lib/Moose/Meta/Method/Delegation.pm @@ -18,18 +18,28 @@ sub new { my $class = shift; my %options = @_; - (exists $options{attribute}) + ( exists $options{attribute} ) || confess "You must supply an attribute to construct with"; - (blessed($options{attribute}) && $options{attribute}->isa('Moose::Meta::Attribute')) - || confess "You must supply an attribute which is a 'Moose::Meta::Attribute' instance"; + ( blessed( $options{attribute} ) + && $options{attribute}->isa('Moose::Meta::Attribute') ) + || confess + "You must supply an attribute which is a 'Moose::Meta::Attribute' instance"; - ($options{package_name} && $options{name}) - || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; + ( $options{package_name} && $options{name} ) + || confess + "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; - my $self = $class->_new(\%options); + ( $options{delegate_to_method} && ( !ref $options{delegate_to_method} ) + || ( 'CODE' eq ref $options{delegate_to_method} ) ) + || confess + 'You must supply a delegate_to_method which is a method name or a CODE reference'; - weaken($self->{'attribute'}); + my $self = $class->_new( \%options ); + + weaken( $self->{'attribute'} ); + + $self->_initialize_body; return $self; } @@ -43,6 +53,50 @@ sub _new { sub associated_attribute { (shift)->{'attribute'} } +sub delegate_to_method { (shift)->{'delegate_to_method'} } + +sub _initialize_body { + my $self = shift; + + my $method_to_call = $self->delegate_to_method; + return $self->{body} = $method_to_call + if ref $method_to_call; + + my $accessor = $self->_get_delegate_accessor; + + my $handle_name = $self->name; + + # 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 + $self->{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(@_); + }; +} + +sub _get_delegate_accessor { + my $self = shift; + + my $accessor = $self->associated_attribute->get_read_method_ref; + + $accessor = $accessor->body if blessed $accessor; + + return $accessor; +} + 1; __END__ @@ -74,12 +128,21 @@ these options are: This must be an instance of C which this accessor is being generated for. This paramter is B. +=item I + +The method in the associated attribute's value to which we +delegate. This can be either a method name or a code reference. + =back =item B Returns the attribute associated with this method. +=item B + +Returns the method to which this method delegates. + =back =head1 BUGS