{  package Encapsulate;
   use Scalar::Util;
   use Carp;

   my $Secrets = {};
   use overload
       '%{}' => sub {
          my $obj = shift;
          my $caller_pkg = caller;
          my $pkg = ref $obj;
          if ( !$pkg->isa( $caller_pkg ) &&
               !$caller_pkg->isa( $pkg )) {
             croak "Illegal attemp to access $pkg " .
                   "internals from $caller_pkg";
          }
          my $id = Scalar::Util::refaddr( $obj );
          return $Secrets->{ $id } ||= {};
   }, fallback => 1;
   
   sub DESTROY {
      my $id = Scalar::Util::refaddr( shift );
      delete $Secrets->{ $id };
   }
}

{   package Foo;
    use base qw( Encapsulate );

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

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

{   package Bar;
    use base qw( Foo );

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

{   package Quux;
    use base qw( Encapsulate );

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

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

use Test::More tests => 7;

my $o = Bar->new;
isa_ok $o, 'Bar';

$o->foo( 42 );
is $o->foo, 42, "can set and get value of Foo's secret";

Bar->new->foo( 24 );
is $o->foo, 42, "different objects get different secrets";

Quux->new->foo( 24 );
is $o->foo, 42, "different classes get different secrets";

$o->bar( 99 );
is $o->bar, 99, "can set and get value of Bar's secret";

is $o->foo, 99, "secrets of subclasses are shared";

eval {
   $o->{secret};
};
ok $@, 'cannot reach into objects';