Commit | Line | Data |
---|---|---|
777fcfcf | 1 | package MooObjectWithDelegate; |
2 | use ClassicObject; | |
3 | use Moo; | |
4 | ||
5 | has 'delegated' => ( | |
6 | is => 'ro', | |
7 | isa => sub { | |
8 | do { $_[0] && blessed($_[0]) } | |
9 | or die "Not an Object!"; | |
10 | }, | |
11 | lazy => 1, | |
12 | builder => '_build_delegated', | |
13 | handles => [qw/connect/], | |
14 | ); | |
15 | ||
16 | sub _build_delegated { | |
17 | my $self = shift; | |
18 | return ClassicObject->new; | |
19 | } | |
20 | ||
21 | around 'connect', sub { | |
22 | my ($orig, $self, @args) = @_; | |
23 | return $self->$orig(@args) . 'b'; | |
24 | }; | |
25 | ||
26 | ||
27 | 1; |