package Ties;
# use warnings;	# Remove this for production. Assumes perl 5.6
use strict;

my $ties = 0;

sub count {
    return $ties;
}

END {
    die "You still have ties hanging" if $ties;
}

package Stie;
my $sfetches = 0;

sub TIESCALAR {
    my ($class, $value) = @_;
    $ties++;
    return bless [$value], $class;
}

sub FETCH {
    $sfetches++;
    return shift->[0];
}

sub DESTROY {
    $ties--;
}

sub fetches {
    my $old = $sfetches;
    $sfetches = 0;
    return $old;
}

package Atie;
my $afetches = 0;
sub TIEARRAY {
    my $class = shift;
    $ties++;
    return bless {foo => \@_}, $class;
}

sub FETCH {
    $afetches++;
    # main::diag("Array fetch @_");
    return $_[0]->{foo}[$_[1]];
}

sub FETCHSIZE {
    return scalar @{shift->{foo}};
}

sub DESTROY {
    $ties--;
}

sub fetches {
    my $old = $afetches;
    $afetches = 0;
    return $old;
}

package Htie;
my $hfetches = 0;
sub TIEHASH {
    my ($class, %hash) = @_;
    $ties++;
    return bless [\%hash], $class;
}

sub FETCH {
    $hfetches++;
    return $_[0][0]{$_[1]};
}

sub FIRSTKEY {
    my $array = shift;
    keys %{$array->[0]};	# reset each
    return each %{$array->[0]};
}

sub NEXTKEY {
    my $array = shift;
    return each %{$array->[0]};
}

sub EXISTS {
    return exists $_[0][0]{$_[1]};
}

sub DESTROY {
    $ties--;
}

sub fetches {
    my $old = $hfetches;
    $hfetches = 0;
    return $old;
}

1;