2 package Moose::Meta::Method::Delegation;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.70';
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<new (%options)>
126 This creates the method based on the criteria in C<%options>,
133 This must be an instance of C<Moose::Meta::Attribute> which this
134 accessor is being generated for. This parameter is B<required>.
136 =item I<delegate_to_method>
138 The method in the associated attribute's value to which we
139 delegate. This can be either a method name or a code reference.
143 =item B<associated_attribute>
145 Returns the attribute associated with this method.
147 =item B<delegate_to_method>
149 Returns the method to which this method delegates.
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.