use strict; use warnings; use Test::More 'tests' => 11; # The::Borg is a class we want to delegate to... package The::Borg; { use Object::InsideOut; sub assimilate { return "You will be assimilated"; } sub admonish { return "Resistance is futile"; } sub advise { return "We will add your biological and cultural distinctiveness to our own"; } sub answer { return "No"; } } # Federation is another class we want to delegate to... package Federation; { use Object::InsideOut; sub assimilate { return "Welcome to the Federation"; } sub admonish { return "Respect the Prime Directive"; } sub advise { my ($self, $who) = @_; return "We come in peace, $who (shoot to kill!)"; } sub answer { return "Ye kenna change the laws o' physics"; } sub assist { return "The Prime Directive forbids us to intervene"; } } package Foo; { use Object::InsideOut; sub foo { return 'bar'; } } package Delegator; { use Object::InsideOut; my @borg :Field(Std=>'borg', Handles=>'engulf-->assimilate') :Type(The::Borg); my @fed :Field('Std'=>'fed', 'Handles'=>'admonish advise', Type=>'Federation'); my @foo :Field('Std'=>'foo') :Handle('baz' --> 'foo') :Handle('bar' --> 'foo'); sub init : Init { my ($self, $args) = @_; $self->set_borg(The::Borg->new()); $self->set_fed(Federation->new()); $self->set_foo(Foo->new()); } sub answer : Method { return "Aye, captain"; } } package DelegatorClassy; { use Object::InsideOut; my @borg :Field(Std=>'borg', Handles=>'The::Borg') :Type(The::Borg); my @fed :Std(fed) :Handles(Federation::) :Type(Federation); sub init : Init { my ($self, $args) = @_; $self->set_borg(The::Borg->new()); $self->set_fed(Federation->new()); } sub answer : Method { return "Aye, captain"; } } package main; MAIN: { my $obj = Delegator->new(); is($obj->engulf, The::Borg->assimilate, 'engulf delegated to Borg->assimilate'); is($obj->admonish, Federation->admonish, 'admonish delegated to Federation'); is($obj->advise('sir'), Federation->advise('sir'), 'advise delegated to Federation'); is($obj->answer, Delegator->answer, 'answer did not delegate'); is($obj->baz, Foo->foo, 'first :Handle works'); is($obj->bar, Foo->foo, 'second :Handle works'); } { my $obj = DelegatorClassy->new(); is($obj->assimilate, The::Borg->assimilate, 'assimilate delegated to Borg'); is($obj->admonish, The::Borg->admonish, 'admonish delegated to Borg'); is($obj->advise('sir'), The::Borg->advise('sir'), 'advise delegated to Borg'); is($obj->assist(), Federation->assist(), 'assist delegated to Federation'); is($obj->answer, DelegatorClassy->answer, 'answer did not delegate'); } exit(0); # EOF