package Toy::Hash;

use strict;
use warnings;

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

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

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

package main;
use strict;

our $H;

my @k = ( 1..30 );
tie( my %h, 'Toy::Hash', map { $_, $_ * $_ } @k );
$H = \%h;

sub is_H_tied {
  my $m = ( caller( 1 ) )[3];
  print "in $m, tied(\%\$H) is ". (tied( %{$::H} ) || "''"). " Ref:($H)\n";
  print "in $m, tied(\%h) is ". (tied( %h ) || "''"). "\n";
}

print "Ref \$H: $H\n\n";
print "Before STORE: %\$H - %\$H - ",tied(%$H) . "\t\%h -" . tied(%h). "\n";
$H->{foo}="bar";
print "After  STORE: %\$H - ",tied(%$H) . "\t\%h -" . tied(%h). "\n\n";
print "Ref \$H: $H\n\n";
print "Before CLEAR: %\$H - ",tied(%$H) . "\t\%h -" . tied(%h). "\n";
%$H=();
print "After  CLEAR: %\$H - ",tied(%$H) . "\t\%h -" . tied(%h). "\n\n";
print "Ref \$H: $H\n";