package MonitorHash;
require Exporter;
@ISA = ("Exporter");
@EXPORT = qw(monitor unmonitor foo monitor_elems pushElems monitored_key_is_set);
use strict;

my %BOOL_ELEM_FOUND = ();
my $ARR_REF_ELEMS;

sub monitor {
   my ($r_var, $name) = @_;
   my ($type) = ref($r_var);
   if ($type =~ /HASH/) {
       return tie %$r_var, 'Monitor::Hash', $r_var, $name;
   } else {
       print STDERR "require ref. to scalar, array or hash" unless $type;
   }
}
sub monitor_elems {
   my ($r_var, $name) = @_;
   my ($type) = ref($r_var);
   if ($type =~ /SCALAR/) {
       return tie $$r_var, 'Monitor::Scalar', $r_var, $name;
   } elsif ($type =~ /HASH/) {
       $BOOL_ELEM_FOUND{$name} = 0;
       return tie %$r_var, 'Monitor::Hash', $r_var, $name;
   } else {
       print STDERR "require ref. to scalar, array or hash" unless $type;
   }
}
sub unmonitor {
   my ($r_var) = @_;
   my ($type) = ref($r_var);
   my $obj;
   if ($type =~ /SCALAR/) {
       Monitor::Scalar->unmonitor($r_var);
   } elsif ($type =~ /ARRAY/) {
       Monitor::Array->unmonitor($r_var);
   } elsif ($type =~ /HASH/) {
       Monitor::Hash->unmonitor($r_var);
   } else {
       print STDERR "require ref. to scalar, array or hash" unless $type;
   } 
}

sub monitored_key_is_set ($) { $BOOL_ELEM_FOUND{$_[0]} }
sub pushElems ($) { $ARR_REF_ELEMS = $_[0]; }
#------------------------------------------------------------------------
package Monitor::Hash;
sub TIEHASH {
   my ($pkg, $rhash, $name) = @_;
   my $obj = [$name, {%$rhash}];
   return (bless $obj, $pkg);
}

sub CLEAR {
   my ($obj) = @_;
   print STDERR 'Cleared %', $obj->[0], "\n";
}

sub FETCH {
   my ($obj, $index) = @_;
   my $val = $obj->[1]->{$index};
   print STDERR 'Read    $', $obj->[0], "{$index} ... $val\n";
   return $val;
}

sub STORE {
   my ($obj, $index, $val) = @_;
   # print STDERR 'Wrote   $', $obj->[0], "{$index} ... $val\n";
   $obj->[1]->{$index} = $val;
   foreach (@{$ARR_REF_ELEMS}) {
	if ($_ eq $index) {
		# print "TSCHAKKA!!!!!!!!\n";
		$BOOL_ELEM_FOUND{$obj->[0]}++;
		last;
	}
   }
   return $val;
}

sub DESTROY {
   my ($obj) = @_;
   if ($obj->[0] ne '_UNMONITORED_') {
      # print STDERR 'Died    %', $obj->[0];
   }
}
sub unmonitor {
   my ($pkg, $r_var) = @_;
   my $r_hash;
   {
      my $obj = tied %$r_var;
      $r_hash = $obj->[1];
      $obj->[0] = "_UNMONITORED_";
   }
   untie %$r_var;
   %$r_var = %$r_hash;
}

1;