Wrequire 'My::Hash';
our @ISA=qw(My::Hash);
use Carp qw(cluck confess);
+require Data::Compare;
+# You are recommended to STORE all the keys, not to parent-inherit them.
+
+
+sub _normalize($$)
+{
+my($self,$val)=@_;
+
+ $val=[] if !defined $val;
+ $val=[$val] if "ARRAY" ne ref($val);
+ return $val;
+}
+
+sub _ours($$)
+{
+my($self,$key,$state)=@_;
+
+ my $ref=\$self->{"ours"}{$key};
+ warn "State change for key \"$key\"; was=".(0+$$ref).",now=".(0+$state)
+ if defined($state) && defined($$ref) && $state!=$$ref;
+ $$ref=$state if defined $state;
+ return $$ref;
+}
+
sub STORE
{
my($this,$key,$value)=@_;
- return $this->pass("STORE",$key,$value) if $key!~/_push$/;
- my $val_orig=$this->pass("FETCH",$key);
- $val_orig=[] if !defined $val_orig;
- $val_orig=[$val_orig] if "ARRAY" ne ref $val_orig;
- return $this->pass("STORE",$key,[@$val_orig,$value]);
+ if ($key=~s/_push$//) {
+ $this->_ours($key,1);
+ return $this->pass("STORE",$key,[@{$this->_normalize($this->pass("FETCH",$key))},$value]);
+ }
+ if ($key=~s/_pop$//) {
+ $this->_ours($key,1);
+ my $val_orig=$this->FETCH($key);
+ for my $vali (reverse 0..$#$val_orig) {
+ next if Data::Compare::Compare($val_orig->[$vali],$value);
+ splice @$val_orig,$vali,1;
+ return $this->pass("STORE",$key,$val_orig);
+ }
+ cluck "value[1] not found in the array[2] of key[0]:\n".Dumper($key,$value,$val_orig);
+ return;
+ }
+ if ($key=~s/_set$//) {
+ $this->_ours($key,1);
+ return $this->pass("STORE",$key,$this->_normalize($value));
+ }
+ $this->_ours($key,0);
+ return $this->pass("STORE",$key,$value);
}
sub FETCH($$)
{
-my($this,$key)=@_;
+my($this,$key_orig)=@_;
+ my $force=((my $key=$key_orig)=~s/_push$//);
+ $this->_ours($key,1) if $force;
my $val=$this->pass("FETCH",$key);
- return $val if $key!~/_push$/;
- $val=[] if !defined $val;
- $val=[$val] if "ARRAY" ne ref($val);
+ return $this->_normalize($val) if $force || $this->_ours($key);
return $val;
}