6 use Test::More tests => 58;
13 # -------------------------------------------------------------------
15 # -------------------------------------------------------------------
16 # the canonical form of of the 'handles'
17 # option is the hash ref mapping a
18 # method name to the delegated method name
24 has 'bar' => (is => 'rw', default => 10);
31 default => sub { Foo->new },
32 handles => { 'foo_bar' => 'bar' }
39 ok($bar->foo, '... we have something in bar->foo');
40 isa_ok($bar->foo, 'Foo');
42 is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');
44 can_ok($bar, 'foo_bar');
45 is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');
47 # change the value ...
51 # and make sure the delegation picks it up
53 is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
54 is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
56 # change the value through the delegation ...
60 # and make sure everyone sees it
62 is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
63 is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
65 # change the object we are delegating too
67 my $foo = Foo->new(bar => 25);
70 is($foo->bar, 25, '... got the right foo->bar');
74 } '... assigned the new Foo to Bar->foo';
76 is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
78 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
79 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
81 # -------------------------------------------------------------------
83 # -------------------------------------------------------------------
84 # we also support an array based format
85 # which assumes that the name is the same
92 sub go { 'Engine::go' }
93 sub stop { 'Engine::stop' }
100 default => sub { Engine->new },
101 handles => [ 'go', 'stop' ]
108 isa_ok($car->engine, 'Engine');
109 can_ok($car->engine, 'go');
110 can_ok($car->engine, 'stop');
112 is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go');
113 is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop');
116 can_ok($car, 'stop');
118 is($car->go, 'Engine::go', '... got the right value from ->go');
119 is($car->stop, 'Engine::stop', '... got the right value from ->stop');
121 # -------------------------------------------------------------------
123 # -------------------------------------------------------------------
124 # and we support regexp delegation
130 sub foo { 'Baz::foo' }
131 sub bar { 'Baz::bar' }
132 sub boo { 'Baz::boo' }
140 default => sub { Baz->new },
150 default => sub { Baz->new },
160 default => sub { Baz->new },
166 my $baz_proxy = Baz::Proxy1->new;
167 isa_ok($baz_proxy, 'Baz::Proxy1');
169 can_ok($baz_proxy, 'baz');
170 isa_ok($baz_proxy->baz, 'Baz');
172 can_ok($baz_proxy, 'foo');
173 can_ok($baz_proxy, 'bar');
174 can_ok($baz_proxy, 'boo');
176 is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
177 is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
178 is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
181 my $baz_proxy = Baz::Proxy2->new;
182 isa_ok($baz_proxy, 'Baz::Proxy2');
184 can_ok($baz_proxy, 'baz');
185 isa_ok($baz_proxy->baz, 'Baz');
187 can_ok($baz_proxy, 'foo');
188 can_ok($baz_proxy, 'boo');
190 is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
191 is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
194 my $baz_proxy = Baz::Proxy3->new;
195 isa_ok($baz_proxy, 'Baz::Proxy3');
197 can_ok($baz_proxy, 'baz');
198 isa_ok($baz_proxy->baz, 'Baz');
200 can_ok($baz_proxy, 'bar');
201 can_ok($baz_proxy, 'boo');
203 is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
204 is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
207 # -------------------------------------------------------------------
209 # -------------------------------------------------------------------
221 sub foo { 'Foo::Baz::FOO' }
222 sub bar { 'Foo::Baz::BAR' }
223 sub baz { 'Foo::Baz::BAZ' }
231 handles => 'Foo::Bar',
237 my $foo = Foo::Thing->new(thing => Foo::Baz->new);
238 isa_ok($foo, 'Foo::Thing');
239 isa_ok($foo->thing, 'Foo::Baz');
241 ok($foo->meta->has_method('foo'), '... we have the method we expect');
242 ok($foo->meta->has_method('bar'), '... we have the method we expect');
243 ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
245 is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
246 is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
247 is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');