From: short <>
Date: Fri, 23 Sep 2005 02:46:49 +0000 (+0000)
Subject: Support "_push", "_pop", "_set" keys.
X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=commitdiff_plain;h=45fc404678bcdc1586d8df9415558929a34459c2

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

diff --git a/Hash/Push.pm b/Hash/Push.pm
index fd5668f..fe7dddc 100644
--- 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;
 }