Support "_push", "_pop", "_set" keys.

diff --git a/Hash/Push.pm b/Hash/Push.pm
index fd5668f..fe7dddc 100644 (file)
--- a/Hash/Push.pm
+++ b/Hash/Push.pm
@@ -25,27 +25,67 @@ use My::Web;        # for &Wrequire
 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;
 }