# 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;
#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);
}
# 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;
}
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,
);
}
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;
}
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__
This must be an instance of C<Moose::Meta::Attribute> which this
accessor is being generated for. This paramter is B<required>.
+=item I<delegate_to_method>
+
+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<associated_attribute>
Returns the attribute associated with this method.
+=item B<delegate_to_method>
+
+Returns the method to which this method delegates.
+
=back
=head1 BUGS
projects / gitmo/Moose.git / commitdiff