# $Id$ # Hash tied to restrict access to the specified keys list. # 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::RestrictTo; 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,@keys)=@_; my $self=$class->SUPER::TIEHASH($parent); $self->{"keyshash"}={ map(($_=>1),@keys) }; return $self; } sub STORE($$$) { my($this,$key,$value)=@_; confess "Key not permitted: $key" if !$this->{"keyshash"}{$key}; return $this->pass("STORE",$key,$value); } sub FETCH($$) { my($this,$key)=@_; confess "Key not permitted: $key" if !$this->{"keyshash"}{$key}; return $this->pass("FETCH",$key); } sub FIRSTKEY($) { my($this)=@_; my $a=keys(%{$this->{"keyshash"}}); return $this->NEXTKEY($this,undef()); } sub NEXTKEY($$) { my($this,$lastkey)=@_; cluck "TODO: Enumeration may not be expected."; for (;;) { my $key=each(%{$this->{"keyshash"}}); return if !defined $key; return $key if exists $this->{"parent"}{$key}; } } sub EXISTS($$) { my($this,$key)=@_; confess "Key not permitted: $key" if !$this->{"keyshash"}{$key}; return $this->pass("EXISTS",$key); } sub DELETE($$) { my($this,$key)=@_; confess "Key not permitted: $key" if !$this->{"keyshash"}{$key}; return $this->pass("DELETE",$key); } sub CLEAR($) { my($this)=@_; cluck "TODO: Enumeration may not be expected."; delete $this->{"parent"}{$_} for keys(%{$this->{"keyshash"}}); } sub SCALAR { my($this)=@_; confess "TODO: Not yet implemented."; } 1;