2 package Moose::Meta::Method::Delegation;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.93';
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 exists $options{curried_arguments}
40 || ( $options{curried_arguments} = [] );
42 ( $options{curried_arguments} &&
43 ( 'ARRAY' eq ref $options{curried_arguments} ) )
44 || confess 'You must supply a curried_arguments which is an ARRAY reference';
46 my $self = $class->_new( \%options );
48 weaken( $self->{'attribute'} );
50 $self->_initialize_body;
57 my $options = @_ == 1 ? $_[0] : {@_};
59 return bless $options, $class;
62 sub curried_arguments { (shift)->{'curried_arguments'} }
64 sub associated_attribute { (shift)->{'attribute'} }
66 sub delegate_to_method { (shift)->{'delegate_to_method'} }
68 sub _initialize_body {
71 my $method_to_call = $self->delegate_to_method;
72 return $self->{body} = $method_to_call
73 if ref $method_to_call;
75 my $accessor = $self->_get_delegate_accessor;
77 my $handle_name = $self->name;
79 # NOTE: we used to do a goto here, but the goto didn't handle
80 # failure correctly (it just returned nothing), so I took that
81 # out. However, the more I thought about it, the less I liked it
82 # doing the goto, and I preferred the act of delegation being
83 # actually represented in the stack trace. - SL
84 # not inlining this, since it won't really speed things up at
85 # all... the only thing that would end up different would be
86 # interpolating in $method_to_call, and a bunch of things in the
87 # error handling that mostly never gets called - doy
90 my $proxy = $instance->$accessor();
93 = !defined $proxy ? ' is not defined'
94 : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
99 "Cannot delegate $handle_name to $method_to_call because "
101 . $self->associated_attribute->name
103 method_name => $method_to_call,
107 unshift @_, @{ $self->curried_arguments };
108 $proxy->$method_to_call(@_);
112 sub _get_delegate_accessor {
114 my $attr = $self->associated_attribute;
117 # always use a named method when
118 # possible, if you use the method
119 # ref and there are modifiers on
120 # the accessors then it will not
121 # pick up the modifiers too. Only
122 # the named method will assure that
123 # we also have any modifiers run.
125 my $accessor = $attr->has_read_method
126 ? $attr->get_read_method
127 : $attr->get_read_method_ref;
129 $accessor = $accessor->body if Scalar::Util::blessed $accessor;
142 Moose::Meta::Method::Delegation - A Moose Method metaclass for delegation methods
146 This is a subclass of L<Moose::Meta::Method> for delegation
153 =item B<< Moose::Meta::Method::Delegation->new(%options) >>
155 This creates the delegation methods based on the provided C<%options>.
161 This must be an instance of C<Moose::Meta::Attribute> which this
162 accessor is being generated for. This options is B<required>.
164 =item I<delegate_to_method>
166 The method in the associated attribute's value to which we
167 delegate. This can be either a method name or a code reference.
169 =item I<curried_arguments>
171 An array reference of arguments that will be prepended to the argument list for
172 any call to the delegating method.
176 =item B<< $metamethod->associated_attribute >>
178 Returns the attribute associated with this method.
180 =item B<< $metamethod->curried_arguments >>
182 Return any curried arguments that will be passed to the delegated method.
184 =item B<< $metamethod->delegate_to_method >>
186 Returns the method to which this method delegates, as passed to the
193 All complex software has bugs lurking in it, and this module is no
194 exception. If you find a bug please either email me, or add the bug
199 Dave Rolsky E<lt>autarch@urth.orgE<gt>
201 =head1 COPYRIGHT AND LICENSE
203 Copyright 2009 by Infinity Interactive, Inc.
205 L<http://www.iinteractive.com>
207 This library is free software; you can redistribute it and/or modify
208 it under the same terms as Perl itself.