6 use Test::More tests => 89;
11 # -------------------------------------------------------------------
13 # -------------------------------------------------------------------
14 # the canonical form of of the 'handles'
15 # option is the hash ref mapping a
16 # method name to the delegated method name
22 has 'bar' => (is => 'rw', default => 10);
29 default => sub { Foo->new },
32 'foo_bar_to_20' => [ bar => [ 20 ] ],
40 ok($bar->foo, '... we have something in bar->foo');
41 isa_ok($bar->foo, 'Foo');
43 my $meth = Bar->meta->get_method('foo_bar');
44 isa_ok($meth, 'Moose::Meta::Method::Delegation');
45 is($meth->associated_attribute->name, 'foo',
46 'associated_attribute->name for this method is foo');
48 is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');
50 can_ok($bar, 'foo_bar');
51 is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');
53 # change the value ...
57 # and make sure the delegation picks it up
59 is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
60 is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
62 # change the value through the delegation ...
66 # and make sure everyone sees it
68 is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
69 is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
71 # change the object we are delegating too
73 my $foo = Foo->new(bar => 25);
76 is($foo->bar, 25, '... got the right foo->bar');
80 } '... assigned the new Foo to Bar->foo';
82 is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
84 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
85 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
89 is($bar->foo_bar, 20, '... correctly curried a single argument');
91 # -------------------------------------------------------------------
93 # -------------------------------------------------------------------
94 # we also support an array based format
95 # which assumes that the name is the same
102 sub go { 'Engine::go' }
103 sub stop { 'Engine::stop' }
110 default => sub { Engine->new },
111 handles => [ 'go', 'stop' ]
118 isa_ok($car->engine, 'Engine');
119 can_ok($car->engine, 'go');
120 can_ok($car->engine, 'stop');
122 is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go');
123 is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop');
126 can_ok($car, 'stop');
128 is($car->go, 'Engine::go', '... got the right value from ->go');
129 is($car->stop, 'Engine::stop', '... got the right value from ->stop');
131 # -------------------------------------------------------------------
133 # -------------------------------------------------------------------
134 # and we support regexp delegation
140 sub foo { 'Baz::foo' }
141 sub bar { 'Baz::bar' }
142 sub boo { 'Baz::boo' }
150 default => sub { Baz->new },
160 default => sub { Baz->new },
170 default => sub { Baz->new },
176 my $baz_proxy = Baz::Proxy1->new;
177 isa_ok($baz_proxy, 'Baz::Proxy1');
179 can_ok($baz_proxy, 'baz');
180 isa_ok($baz_proxy->baz, 'Baz');
182 can_ok($baz_proxy, 'foo');
183 can_ok($baz_proxy, 'bar');
184 can_ok($baz_proxy, 'boo');
186 is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
187 is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
188 is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
191 my $baz_proxy = Baz::Proxy2->new;
192 isa_ok($baz_proxy, 'Baz::Proxy2');
194 can_ok($baz_proxy, 'baz');
195 isa_ok($baz_proxy->baz, 'Baz');
197 can_ok($baz_proxy, 'foo');
198 can_ok($baz_proxy, 'boo');
200 is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
201 is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
204 my $baz_proxy = Baz::Proxy3->new;
205 isa_ok($baz_proxy, 'Baz::Proxy3');
207 can_ok($baz_proxy, 'baz');
208 isa_ok($baz_proxy->baz, 'Baz');
210 can_ok($baz_proxy, 'bar');
211 can_ok($baz_proxy, 'boo');
213 is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
214 is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
217 # -------------------------------------------------------------------
219 # -------------------------------------------------------------------
231 sub foo { 'Foo::Baz::FOO' }
232 sub bar { 'Foo::Baz::BAR' }
233 sub baz { 'Foo::Baz::BAZ' }
241 handles => 'Foo::Bar',
247 my $foo = Foo::Thing->new(thing => Foo::Baz->new);
248 isa_ok($foo, 'Foo::Thing');
249 isa_ok($foo->thing, 'Foo::Baz');
251 ok($foo->meta->has_method('foo'), '... we have the method we expect');
252 ok($foo->meta->has_method('bar'), '... we have the method we expect');
253 ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
255 is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
256 is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
257 is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');
260 # -------------------------------------------------------------------
262 # -------------------------------------------------------------------
265 package Foo::Autoloaded;
271 my $name = our $AUTOLOAD;
272 $name =~ s/.*://; # strip fully-qualified portion
275 return $self->{$name} = shift;
277 return $self->{$name};
281 package Bar::Autoloaded;
286 default => sub { Foo::Autoloaded->new },
287 handles => { 'foo_bar' => 'bar' }
290 package Baz::Autoloaded;
295 default => sub { Foo::Autoloaded->new },
299 package Goorch::Autoloaded;
305 default => sub { Foo::Autoloaded->new },
308 } '... you cannot delegate to AUTOLOADED class with regexp';
311 # check HASH based delegation w/ AUTOLOAD
314 my $bar = Bar::Autoloaded->new;
315 isa_ok($bar, 'Bar::Autoloaded');
317 ok($bar->foo, '... we have something in bar->foo');
318 isa_ok($bar->foo, 'Foo::Autoloaded');
320 # change the value ...
324 # and make sure the delegation picks it up
326 is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
327 is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
329 # change the value through the delegation ...
333 # and make sure everyone sees it
335 is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
336 is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
338 # change the object we are delegating too
340 my $foo = Foo::Autoloaded->new;
341 isa_ok($foo, 'Foo::Autoloaded');
345 is($foo->bar, 25, '... got the right foo->bar');
349 } '... assigned the new Foo to Bar->foo';
351 is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
353 is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
354 is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
357 # check ARRAY based delegation w/ AUTOLOAD
360 my $baz = Baz::Autoloaded->new;
361 isa_ok($baz, 'Baz::Autoloaded');
363 ok($baz->foo, '... we have something in baz->foo');
364 isa_ok($baz->foo, 'Foo::Autoloaded');
366 # change the value ...
370 # and make sure the delegation picks it up
372 is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value');
373 is($baz->bar, 30, '... baz->foo_bar delegated correctly');
375 # change the value through the delegation ...
379 # and make sure everyone sees it
381 is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value');
382 is($baz->bar, 50, '... baz->foo_bar delegated correctly');
384 # change the object we are delegating too
386 my $foo = Foo::Autoloaded->new;
387 isa_ok($foo, 'Foo::Autoloaded');
391 is($foo->bar, 25, '... got the right foo->bar');
395 } '... assigned the new Foo to Baz->foo';
397 is($baz->foo, $foo, '... assigned baz->foo with the new Foo');
399 is($baz->foo->bar, 25, '... baz->foo->bar returned the right result');
400 is($baz->bar, 25, '... and baz->foo_bar delegated correctly again');
403 # Check that removing attributes removes their handles methods also.
410 default => sub { Foo->new },
411 handles => { 'foo_bar' => 'bar' }
415 ok($i->meta->has_method('foo_bar'), 'handles method foo_bar is present');
416 $i->meta->remove_attribute('foo');
417 ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed');