#!/usr/bin/perl

use strict;
use warnings;

package my_hash;
use strict;
sub TIEHASH {
	my ($class, $obj) = @_;
	my $self = {%$obj};
        $self->{_true_obj} = $obj;
	bless $self, $class;
}
sub FETCH {
#        print STDERR "FETCH @_";
	my ($self, $key) = @_;
        my $rv = 	 ($key =~ /^_/) ?
		$self->{$key} :
		$self->{_true_obj}->value($key);
#        print STDERR "FETCH RESULT $rv";
        $rv;
        
}
sub STORE {
	my ($self, $key, $value) = @_;
        if ($key =~ /^_/) {
          $self->{$key} = $value;
        } else {
          $self->{_true_obj}{$key} = $value;
        }
}

# these are just for debugging purposes
sub FIRSTKEY {
        my $x = shift;
        keys %$x;
        each %$x;
}

sub NEXTKEY {
        my $x = shift;
        each %$x;
}

package my_obj;
use strict;
sub new { bless my $true_obj = {}; 
          my %fake_obj;
          tie %fake_obj, 'my_hash', $true_obj;
          bless \%fake_obj;
        }
          
sub value { return $_[0]->{$_[1]} }


package main;
local $\ = "\n";

# initialise our tied and blessed object

my $hash = my_obj->new();

# check everything is as it should be
print ref $hash;
print ref tied %$hash;

# initialise variables
$hash->{x} = "y";
$hash->{z} = { a => "b", c => [ "d" ] };
print STDERR "Looking up 'x'\n";
print $hash->{x};			# 0: works (axiom tester)

print $hash->value("z")->{a};		# 1: works
print STDERR "Looking up 'z'\n";
my $a = $hash->{z};
print $a->{a};				# 2: works
print +(my $b = $hash->{z})->{a};	# 3: works ('+' to disambiguate)
print STDERR "Looking up 'z->a'\n";
print STDERR "BEGIN";
print $hash->{z}->{a};			# 4: fails!

__END__

=head1 EXPLANATION

Obviously, there would be much simpler ways to implement this code. The actual project requiring an approximation of this functionality, however, requires stateful and dynamic values stored within the keys of each object. When a given key is FETCH'd, its value may then be altered, Heisenberg-style.

The keys should be accessible through both $obj->value($item) and, optionally, $obj->{$item}, and both must have exactly the same effect. For this reason -- and to maintain the state stored in $obj, not to mention cut down on bloat -- I have attempted to call the my_obj object's value() parameter upon a pertinent FETCH call.

This demonstration merely maps hash keys without underscores to those with (e.g, fetching the key "foo" will in actuality retrieve the key "_foo"). The fetch itself is done by value(), as stated above.

However, executing this script clearly demonstrates that #4 B<does not work>. Why?!

=head1 OUTPUT

  my_obj
  my_hash
  y
  b
  b
  b
  Can't use an undefined value as a HASH reference at ./test.pl line 53.

=head1 AUTHOR

Dan Jones <dan@bor.gs>

=cut
