2 package Moose::Meta::Method::Delegation;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.85';
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 preferred 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,
92 || $self->throw_error(
93 "Cannot delegate $handle_name to $method_to_call because "
95 . $self->associated_attribute->name
96 . " is not an object (got '$proxy')",
97 method_name => $method_to_call,
100 $proxy->$method_to_call(@_);
104 sub _get_delegate_accessor {
107 my $accessor = $self->associated_attribute->get_read_method_ref;
109 $accessor = $accessor->body if blessed $accessor;
122 Moose::Meta::Method::Delegation - A Moose Method metaclass for delegation methods
126 This is a subclass of L<Moose::Meta::Method> for delegation
133 =item B<< Moose::Meta::Method::Delegation->new(%options) >>
135 This creates the delegation methods based on the provided C<%options>.
141 This must be an instance of C<Moose::Meta::Attribute> which this
142 accessor is being generated for. This options is B<required>.
144 =item I<delegate_to_method>
146 The method in the associated attribute's value to which we
147 delegate. This can be either a method name or a code reference.
151 =item B<< $metamethod->associated_attribute >>
153 Returns the attribute associated with this method.
155 =item B<< $metamethod->delegate_to_method >>
157 Returns the method to which this method delegates, as passed to the
164 All complex software has bugs lurking in it, and this module is no
165 exception. If you find a bug please either email me, or add the bug
170 Dave Rolsky E<lt>autarch@urth.orgE<gt>
172 =head1 COPYRIGHT AND LICENSE
174 Copyright 2009 by Infinity Interactive, Inc.
176 L<http://www.iinteractive.com>
178 This library is free software; you can redistribute it and/or modify
179 it under the same terms as Perl itself.