X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FDelegation.pm;h=123895551266d6c42f32394fe91136159eeb2b46;hb=02e5f2a7175caab1953e635f3f5defb6c4e85ea5;hp=2fadd1966d23d7516696c70f76be0676e5055ca3;hpb=2de18801c55ae2cfac72d6697e797f3875286d83;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm index 2fadd19..1238955 100644 --- a/lib/Moose/Meta/Method/Delegation.pm +++ b/lib/Moose/Meta/Method/Delegation.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.83'; +our $VERSION = '1.03'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -36,13 +36,12 @@ sub new { || confess 'You must supply a delegate_to_method which is a method name or a CODE reference'; - ( !exists $options{curried_arguments} || ( - $options{curried_arguments} && - ( 'ARRAY' eq ref $options{curried_arguments} ) - ) ) || confess - 'You must supply a curried_arguments which is an ARRAY reference'; + exists $options{curried_arguments} + || ( $options{curried_arguments} = [] ); - $options{curried_arguments} ||= []; + ( $options{curried_arguments} && + ( 'ARRAY' eq ref $options{curried_arguments} ) ) + || confess 'You must supply a curried_arguments which is an ARRAY reference'; my $self = $class->_new( \%options ); @@ -80,7 +79,7 @@ sub _initialize_body { # 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 + # doing the goto, and I preferred the act of delegation being # actually represented in the stack trace. - SL # not inlining this, since it won't really speed things up at # all... the only thing that would end up different would be @@ -89,26 +88,45 @@ sub _initialize_body { $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->associated_attribute->name - . " is not defined", - method_name => $method_to_call, - object => $instance + + my $error + = !defined $proxy ? ' is not defined' + : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')} + : undef; + + if ($error) { + $self->throw_error( + "Cannot delegate $handle_name to $method_to_call because " + . "the value of " + . $self->associated_attribute->name + . $error, + method_name => $method_to_call, + object => $instance ); - my @args = (@{ $self->curried_arguments }, @_); - $proxy->$method_to_call(@args); + } + unshift @_, @{ $self->curried_arguments }; + $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; + my $attr = $self->associated_attribute; + + # NOTE: + # always use a named method when + # possible, if you use the method + # ref and there are modifiers on + # the accessors then it will not + # pick up the modifiers too. Only + # the named method will assure that + # we also have any modifiers run. + # - SL + my $accessor = $attr->has_read_method + ? $attr->get_read_method + : $attr->get_read_method_ref; + + $accessor = $accessor->body if Scalar::Util::blessed $accessor; return $accessor; } @@ -172,9 +190,7 @@ constructor. =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR