{
package Foo;
sub new { bless {}, shift };
sub sane { 42 };
sub insane { 666 };
};
####
{
package SaneFoo;
use Class::Delegation send => 'sane', to => 'Foo';
sub new {
bless { Foo => Foo->new }, shift;
};
};
####
use Test::More tests => 3;
use Test::Exception 0.15;
isa_ok my $o = SaneFoo->new, 'SaneFoo';
lives_and {is $o->sane, 42} 'sane worked';
dies_ok {$o->insane} 'insane failed';
__END__
# test results are:
1..3
ok 1 - The object isa SaneFoo
ok 2 - sane worked
ok 3 - insane failed
####
{
package SaneFoo;
use Carp;
my %Foo = ();
sub new {
my $self = bless {}, shift;
$Foo{$self} = Foo->new;
return($self);
};
sub allows {
my ($self, $method) = @_;
return( $method eq "sane" );
};
sub AUTOLOAD {
my $self = shift;
our $AUTOLOAD;
my ($method) = ($AUTOLOAD =~ m/([^:]+)$/);
croak "$self cannot $method" unless $self->allows($method);
$Foo{$self}->$method;
};
sub DESTROY {
my $self = shift;
delete $Foo{$self};
};
};