#!/afs/athena/contrib/perl5/perl -w

use strict;

package Cheese;

use strict;
use Carp;

sub TIEHASH {
  warn "TIEHASH @_\n";
  my $class = shift;
  bless {@_}, $class;
}

sub FETCH {
  warn "FETCH @_\n";
  my $self = shift;
  my $key = shift;
  $self->{$key};
}

sub STORE {
  warn "STORE @_\n";
  my $self = shift;
  my $key = shift;
  my $val = shift;
  $self->{$key} = $val;

}

sub DELETE {
  warn "DELETE @_\n";
  my $self = shift;
  my $key = shift;
  delete $self->{$key};
}

sub CLEAR {
  warn "CLEAR @_\n";
  my $self = shift;
  %$self = ();
}

sub EXISTS {
  warn "EXISTS @_\n";
  my $self = shift;
  my $key = shift;
  exists $self->{$key};
}

sub FIRSTKEY {
  warn "FIRSTKEY @_\n";
  my $self = shift;
  my $a = keys %$self;          # reset each() iterator
  each %$self;
}

sub NEXTKEY {
  warn "NEXTKEY @_\n";
  my $self = shift;
  each %$self;
}

sub DESTROY {
  warn "DESTROY @_\n";
}

package main;

sub foo {
  my %test;
  tie %test, 'Cheese';
  $test{'this'}  = 1;
  $test{'that'}  = 2;
  $test{'other'} = 3;
  \%test;
}

my $foo = foo();
print "T1: $foo\n";
$foo->{'a'} = 'x';
$foo->{'b'} = 'y';
$foo->{'c'} = 'z';

my @foo = %$foo;
print "foo = @foo\n";

%$foo = (me => 'toasty', I => 'glub');

my @foo = %$foo;
print "foo = @foo\n";
