# Hash2Hash.pm - tiehash module to create another tie()d instance
#		 of an already tie()d hash
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: Hash2Hash.pm,v 2.2 1999/10/06 16:40:59 marek Exp $
#
#	$RCSfile: Hash2Hash.pm,v $
#	$Revision: 2.2 $
#	$Author: marek $
#	$Date: 1999/10/06 16:40:59 $
#

package Hash2Hash;
use Carp;

sub whowasi { (caller(1))[3] . '()' }

# create an object with a tie() reference to the original DB object

sub TIEHASH ($$) {
  my ($self) = shift;
  my ($href) = shift;

  my ($tref) = tied(%$href);

  croak "@{[&whowasi]}: the underlying hash is not tie()d" unless $tref;

  my ($obj) = { tref => $tref };

  return bless $obj, $self;
}

# don't pass DESTROY to the underlying hash, just ignore it

sub DESTROY ($) {
  my ($self) = shift;
}

# pass all other methods to the underlying tie()d hash

sub FETCH ($$) {
  my ($self) = shift;
  my ($key) = shift;

  return $self->{tref}->FETCH($key);
}

sub STORE ($$$) {
  my ($self) = shift;
  my ($key) = shift;
  my ($val) = shift;

  return $self->{tref}->STORE($key, $val);
}

sub DELETE ($$) {
  my ($self) = shift;
  my ($key) = shift;

  return $self->{tref}->DELETE($key);
}

sub CLEAR ($) {
  my ($self) = shift;

  return $self->{tref}->CLEAR;
}

sub EXISTS ($$) {
  my ($self) = shift;
  my ($key) = shift;

  return $self->{tref}->EXISTS($key);
}

sub FIRSTKEY ($) {
  my ($self) = shift;

  return $self->{tref}->FIRSTKEY;
}

sub NEXTKEY ($$) {
  my ($self) = shift;
  my ($key) = shift;

  return $self->{tref}->NEXTKEY($key);
}

1;
# eof
