#!/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; }; }