X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FDelegation.pm;h=32c73c6e5d5077670fdaec34b5f1d5f3f1dc566d;hb=c776160203d49277d4501b76ec02ef10d306193b;hp=5e641907f231209802dd4e2d3c465c25eb8681bf;hpb=e8ec69b65dab6111b542ca1e9ee7bd3cfb0cbdd5;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm index 5e64190..32c73c6 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.84'; +our $VERSION = '1.00'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -88,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; } @@ -171,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