#!/opt/perl5/bin/perl -w

use strict;

package toy::hash;

use strict;

sub TIEHASH {
  my $class = shift;
  return bless { values => { @_ } }, $class;
}

sub STORE {
  my ( $self, $key, $value ) = @_;
  &::is_H_tied();
  $self->{values}{$key} = $value;
}

sub FETCH {
  my ( $self, $key ) = @_;
  &::is_H_tied();
  $self->{values}{$key};
}

sub KEYS {
  my ( $self ) = @_;
  &::is_H_tied();
  keys %{ $self->{values} };
}

sub FIRSTKEY {
  my ( $self ) = @_;
  &::is_H_tied();
  each %{ $self->{values} };
}

sub NEXTKEY {
  my ( $self ) = @_;
  &::is_H_tied();
  each %{ $self->{values} };
}

sub CLEAR {
  my ( $self ) = @_;
  &::is_H_tied();
  %{ $self->{values} } = ();
}

sub EXISTS {
  my ( $self, $key ) = @_;
  &::is_H_tied();
  exists $self->{values}{$key};
}


package main;

our $H;

sub is_H_tied {
  my $m = ( caller( 1 ) )[3];
  print STDERR "method=$m, tied(\%\$H)=", tied( %$H ), "\n";
}

my @k = ( 1..30 );
tie( my %h, 'toy::hash', map { $_, $_ * $_ } @k );

$H = \%h;
die "\n" unless( @ARGV );

for( $ARGV[0] ) {
  /^CLEAR$/o  && do { 
    %h = (); 
    tied( %h )->CLEAR();
    last; 
  };
  /^STORE$/o  && do { 
    $h{pi} = 3.1415926; 
    tied( %h )->STORE( qw( pi 3.1415926 ) );
    last; 
  };
  /^FETCH$/o  && do { 
    my $x = $h{pi}; 
    tied( %h )->FETCH( 'pi' );
    last; 
  };
  /^DELETE$/o && do { 
    delete $h{pi}; 
    tied( %h )->DELETE( 'pi' );
    last; 
  };
  /^KEYS$/o   && do { 
    keys %h; 
    tied( %h )->KEYS();
    last; 
  };
  /^EXISTS$/o && do { 
    exists $h{pi};
    tied( %h )->EXISTS( 'pi' );
    last; 
  };
}
[download]