# $Id$ # Hash tied to record all the accessed keys. # 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::RecordKeys; 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); sub TIEHASH($$) { my($class,$parent)=@_; my $self=$class->SUPER::TIEHASH($parent); $self->{"keyshash"}={}; return $self; } # Call as: my @accessed=tied(%$ref)->accessed(); sub accessed($) { my($self)=@_; return sort keys(%{$self->{"keyshash"}}) } sub STORE($$$) { my($this,$key,$value)=@_; $this->{"keyshash"}{$key}=1; return $this->pass("STORE",$key,$value); } sub FETCH($$) { my($this,$key)=@_; $this->{"keyshash"}{$key}=1; return $this->pass("FETCH",$key); } sub FIRSTKEY($) { my($this)=@_; my $a=keys(%{$this->{"parent"}}); return $this->NEXTKEY($this,undef()); } sub NEXTKEY($$) { my($this,$lastkey)=@_; cluck "TODO: Enumeration may not be expected."; for (;;) { my $key=each(%{$this->{"parent"}}); return if !defined $key; $this->{"keyshash"}{$key}=1; return $key } } sub EXISTS($$) { my($this,$key)=@_; $this->{"keyshash"}{$key}=1; return $this->pass("EXISTS",$key); } sub DELETE($$) { my($this,$key)=@_; $this->{"keyshash"}{$key}=1; return $this->pass("DELETE",$key); } sub CLEAR($) { my($this)=@_; confess "TODO: Not implementable."; } sub SCALAR { my($this)=@_; confess "TODO: Not yet implemented."; } 1;