Commit | Line | Data |
d7d8d49b |
1 | package Mouse::Meta::Method::Delegation; |
3821b191 |
2 | use Mouse::Util qw(:meta); # enables strict and warnings |
3 | use Scalar::Util; |
d7d8d49b |
4 | |
5 | sub _generate_delegation{ |
a2db83e3 |
6 | my (undef, $attribute, $handle_name, $method_to_call, @curried_args) = @_; |
d7d8d49b |
7 | |
cbb81058 |
8 | my $reader = $attribute->get_read_method_ref(); |
d7d8d49b |
9 | return sub { |
10 | my $instance = shift; |
11 | my $proxy = $instance->$reader(); |
12 | |
3821b191 |
13 | my $error = !defined($proxy) ? ' is not defined' |
14 | : ref($proxy) && !Scalar::Util::blessed($proxy) ? qq{ is not an object (got '$proxy')} |
15 | : undef; |
d7d8d49b |
16 | if ($error) { |
17 | $instance->meta->throw_error( |
18 | "Cannot delegate $handle_name to $method_to_call because " |
19 | . "the value of " |
20 | . $attribute->name |
21 | . $error |
22 | ); |
23 | } |
a2db83e3 |
24 | $proxy->$method_to_call(@curried_args, @_); |
d7d8d49b |
25 | }; |
26 | } |
27 | |
28 | |
29 | 1; |
30 | __END__ |
31 | |
32 | =head1 NAME |
33 | |
34 | Mouse::Meta::Method::Delegation - A Mouse method generator for delegation methods |
35 | |
36 | =head1 VERSION |
37 | |
05a12aa4 |
38 | This document describes Mouse version 0.50_01 |
d7d8d49b |
39 | |
40 | =head1 SEE ALSO |
41 | |
42 | L<Moose::Meta::Method::Delegation> |
43 | |
44 | =cut |