2 package Moose::Meta::Method::Delegation;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.77';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
14 use base 'Moose::Meta::Method',
15 'Class::MOP::Method::Generated';
22 ( exists $options{attribute} )
23 || confess "You must supply an attribute to construct with";
25 ( blessed( $options{attribute} )
26 && $options{attribute}->isa('Moose::Meta::Attribute') )
28 "You must supply an attribute which is a 'Moose::Meta::Attribute' instance";
30 ( $options{package_name} && $options{name} )
32 "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
34 ( $options{delegate_to_method} && ( !ref $options{delegate_to_method} )
35 || ( 'CODE' eq ref $options{delegate_to_method} ) )
37 'You must supply a delegate_to_method which is a method name or a CODE reference';
39 my $self = $class->_new( \%options );
41 weaken( $self->{'attribute'} );
43 $self->_initialize_body;
50 my $options = @_ == 1 ? $_[0] : {@_};
52 return bless $options, $class;
55 sub associated_attribute { (shift)->{'attribute'} }
57 sub delegate_to_method { (shift)->{'delegate_to_method'} }
59 sub _initialize_body {
62 my $method_to_call = $self->delegate_to_method;
63 return $self->{body} = $method_to_call
64 if ref $method_to_call;
66 my $accessor = $self->_get_delegate_accessor;
68 my $handle_name = $self->name;
70 # NOTE: we used to do a goto here, but the goto didn't handle
71 # failure correctly (it just returned nothing), so I took that
72 # out. However, the more I thought about it, the less I liked it
73 # doing the goto, and I prefered the act of delegation being
74 # actually represented in the stack trace. - SL
75 # not inlining this, since it won't really speed things up at
76 # all... the only thing that would end up different would be
77 # interpolating in $method_to_call, and a bunch of things in the
78 # error handling that mostly never gets called - doy
81 my $proxy = $instance->$accessor();
83 || $self->throw_error(
84 "Cannot delegate $handle_name to $method_to_call because "
86 . $self->associated_attribute->name
88 method_name => $method_to_call,
91 $proxy->$method_to_call(@_);
95 sub _get_delegate_accessor {
98 my $accessor = $self->associated_attribute->get_read_method_ref;
100 $accessor = $accessor->body if blessed $accessor;
113 Moose::Meta::Method::Delegation - A Moose Method metaclass for delegation methods
117 This is a subclass of L<Moose::Meta::Method> for delegation
124 =item B<< Moose::Meta::Method::Delegation->new(%options) >>
126 This creates the delegation methods based on the provided C<%options>.
132 This must be an instance of C<Moose::Meta::Attribute> which this
133 accessor is being generated for. This options is B<required>.
135 =item I<delegate_to_method>
137 The method in the associated attribute's value to which we
138 delegate. This can be either a method name or a code reference.
142 =item B<< $metamethod->associated_attribute >>
144 Returns the attribute associated with this method.
146 =item B<< $metamethod->delegate_to_method >>
148 Returns the method to which this method delegates, as passed to the
155 All complex software has bugs lurking in it, and this module is no
156 exception. If you find a bug please either email me, or add the bug
161 Dave Rolsky E<lt>autarch@urth.orgE<gt>
163 =head1 COPYRIGHT AND LICENSE
165 Copyright 2009 by Infinity Interactive, Inc.
167 L<http://www.iinteractive.com>
169 This library is free software; you can redistribute it and/or modify
170 it under the same terms as Perl itself.