t/lib/MooObjectWithDelegate.pm

   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;