package SmartHash;
use strict;
use warnings;

use Carp;
use overload
    "%{}" => sub {
        my $caller = caller;
        croak "Illegal object access" unless $caller->isa(__PACKAGE__);
        return shift if $caller eq __PACKAGE__;
        return shift->{$caller} ||= {};
    },
    fallback => 1;
1;

##</code><code>##

package Foo;
use strict;
use warnings;

use base 'SmartHash';

sub new {
    my $class = shift;
    bless {}, $class;
}

sub foo {
    my $self = shift;
    $self->{foo} = shift if @_;
    return $self->{foo};
}

1;

##</code><code>##

package Bar;
use strict;
use warnings;

use base 'Foo';

sub bar {
    my $self = shift;
    $self->{bar} = shift if @_;
    return $self->{bar};
}

sub foo {
    my $self = shift;
    $self->{foo} = shift if @_;
    return $self->{foo};
}

1;

##</code><code>##

use strict;
use warnings;
use Test::More tests => 9;
use Test::Exception;

require_ok( 'Bar' );
require_ok( 'Foo' );

my $o = Bar->new;
my $p = Foo->new;

dies_ok { $o->{bar} = 42 } "dies on direct access";

$o->bar(13);
is( $o->bar, 13, "Bar obj set/get bar" );

$o->foo(42);
is( $o->foo, 42, "Bar obj set/get Bar's foo" );

$o->Foo::foo(23);
is( $o->Foo::foo, 23, "Bar obj set/get Foo's foo" );

$p->foo(99);
is( $p->foo, 99, "Foo obj set/get foo");

is( $o->foo, 42, "Bar obj's foo is still Bar obj's foo" );
is( $o->Foo::foo, 23, "Bar obj's Foo's foo is still Bar obj's Foo's foo" );

##</code><code>##

testfoo....1..9
ok 1 - require Bar;
ok 2 - require Foo;
ok 3 - dies on direct access
ok 4 - Bar obj set/get bar
ok 5 - Bar obj set/get Bar's foo
ok 6 - Bar obj set/get Foo's foo
ok 7 - Foo obj set/get foo
ok 8 - Bar obj's foo is still Bar obj's foo
ok 9 - Bar obj's Foo's foo is still Bar obj's Foo's foo
ok
All tests successful.
Files=1, Tests=9,  0 wallclock secs ( 0.00 cusr +  0.00 csys =  0.00 CPU)