t/039_attribute_delegation.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 46;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 # the canonical form of of the 'handles'
  14 # option is the hash ref mapping a
  15 # method name to the delegated method name
  16
  17 {
  18     package Foo;
  19     use Moose;
  20
  21     has 'bar' => (is => 'rw', default => 10);
  22
  23     package Bar;
  24     use Moose;
  25
  26     has 'foo' => (
  27         is      => 'rw',
  28         default => sub { Foo->new },
  29         handles => { 'foo_bar' => 'bar' }
  30     );
  31 }
  32
  33 my $bar = Bar->new;
  34 isa_ok($bar, 'Bar');
  35
  36 ok($bar->foo, '... we have something in bar->foo');
  37 isa_ok($bar->foo, 'Foo');
  38
  39 is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');
  40
  41 can_ok($bar, 'foo_bar');
  42 is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');
  43
  44 my $foo = Foo->new(bar => 25);
  45 isa_ok($foo, 'Foo');
  46
  47 is($foo->bar, 25, '... got the right foo->bar');
  48
  49 lives_ok {
  50     $bar->foo($foo);
  51 } '... assigned the new Foo to Bar->foo';
  52
  53 is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
  54
  55 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
  56 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
  57
  58 # we also support an array based format
  59 # which assumes that the name is the same
  60 # on either end
  61
  62 {
  63     package Engine;
  64     use Moose;
  65
  66     sub go   { 'Engine::go'   }
  67     sub stop { 'Engine::stop' }
  68
  69     package Car;
  70     use Moose;
  71
  72     has 'engine' => (
  73         is      => 'rw',
  74         default => sub { Engine->new },
  75         handles => [ 'go', 'stop' ]
  76     );
  77 }
  78
  79 my $car = Car->new;
  80 isa_ok($car, 'Car');
  81
  82 isa_ok($car->engine, 'Engine');
  83 can_ok($car->engine, 'go');
  84 can_ok($car->engine, 'stop');
  85
  86 is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go');
  87 is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop');
  88
  89 can_ok($car, 'go');
  90 can_ok($car, 'stop');
  91
  92 is($car->go, 'Engine::go', '... got the right value from ->go');
  93 is($car->stop, 'Engine::stop', '... got the right value from ->stop');
  94
  95 # and we support regexp delegation
  96
  97 {
  98     package Baz;
  99     use Moose;
 100
 101     sub foo { 'Baz::foo' }
 102     sub bar { 'Baz::bar' }
 103     sub boo { 'Baz::boo' }
 104
 105     package Baz::Proxy1;
 106     use Moose;
 107
 108     has 'baz' => (
 109         is      => 'ro',
 110         isa     => 'Baz',
 111         default => sub { Baz->new },
 112         handles => qr/.*/
 113     );
 114
 115     package Baz::Proxy2;
 116     use Moose;
 117
 118     has 'baz' => (
 119         is      => 'ro',
 120         isa     => 'Baz',
 121         default => sub { Baz->new },
 122         handles => qr/.oo/
 123     );
 124
 125     package Baz::Proxy3;
 126     use Moose;
 127
 128     has 'baz' => (
 129         is      => 'ro',
 130         isa     => 'Baz',
 131         default => sub { Baz->new },
 132         handles => qr/b.*/
 133     );
 134 }
 135
 136 {
 137     my $baz_proxy = Baz::Proxy1->new;
 138     isa_ok($baz_proxy, 'Baz::Proxy1');
 139
 140     can_ok($baz_proxy, 'baz');
 141     isa_ok($baz_proxy->baz, 'Baz');
 142
 143     can_ok($baz_proxy, 'foo');
 144     can_ok($baz_proxy, 'bar');
 145     can_ok($baz_proxy, 'boo');
 146
 147     is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
 148     is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
 149     is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
 150 }
 151 {
 152     my $baz_proxy = Baz::Proxy2->new;
 153     isa_ok($baz_proxy, 'Baz::Proxy2');
 154
 155     can_ok($baz_proxy, 'baz');
 156     isa_ok($baz_proxy->baz, 'Baz');
 157
 158     can_ok($baz_proxy, 'foo');
 159     can_ok($baz_proxy, 'boo');
 160
 161     is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
 162     is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
 163 }
 164 {
 165     my $baz_proxy = Baz::Proxy3->new;
 166     isa_ok($baz_proxy, 'Baz::Proxy3');
 167
 168     can_ok($baz_proxy, 'baz');
 169     isa_ok($baz_proxy->baz, 'Baz');
 170
 171     can_ok($baz_proxy, 'bar');
 172     can_ok($baz_proxy, 'boo');
 173
 174     is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
 175     is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
 176 }
 177
 178