The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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