# $Id$ # Hash tied to optionally dynamically generate its values # Copyright (C) 2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; exactly version 2 of June 1991 is required # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA package My::Hash::Push; our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; use strict; use warnings; 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)=@_; 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_orig)=@_; my $force=((my $key=$key_orig)=~s/_push$//); $this->_ours($key,1) if $force; my $val=$this->pass("FETCH",$key); return $this->_normalize($val) if $force || $this->_ours($key); return $val; } 1;