package Tie::ArrayAsHash;

use 5.008005;
use strict;
no warnings;

BEGIN {
    $Tie::ArrayAsHash::AUTHORITY = 'cpan:TOBYINK';
    $Tie::ArrayAsHash::VERSION   = '0.001';
}

use Carp;
use Hash::FieldHash qw(fieldhash);
use Scalar::Util qw(reftype);
use Sub::Exporter -setup => {
    exports => [ 'aeach', 'each' => sub { \&aeach } ],
    groups  => { auto => \&_export_list },
};

sub _export_list
{
    my ($class) = @_;
    my %export = (aeach => \&aeach);
    $export{each} = \&aeach if $^V lt 5.11.0;
    return \%export;
}

use constant {
    IDX_DATA  => 0,
    IDX_EACH  => 1,
    NEXT_IDX  => 2,
};

fieldhash my %cache;

sub aeach (\[@%])
{
    my $thing = shift;
    return CORE::each %$thing
        if reftype $thing eq 'HASH';
    confess "should be passed a HASH or ARRAY"
        unless reftype $thing eq 'ARRAY';
    
    my $thing_h = $cache{$thing} ||= do {
        tie my %h, __PACKAGE__, $thing;
        \%h
    };
    
    CORE::each %$thing_h;
}

sub TIEHASH
{
    my ($class, $arrayref) = @_;
    bless [$arrayref, 0] => $class;
}

sub STORE
{
    my ($self, $k, $v) = @_;
    $self->[IDX_DATA][$k] = $v;
}

sub FETCH
{
    my ($self, $k) = @_;
    $self->[IDX_DATA][$k];
}

sub FIRSTKEY
{
    my ($self) = @_;
    $self->[IDX_EACH] = 0;
    $self->NEXTKEY;
}

sub NEXTKEY
{
    my ($self) = @_;
    my $curr = $self->[IDX_EACH]++;
    return if $curr >= @{ $self->[IDX_DATA] };
    return $curr;
}

sub EXISTS
{
    my ($self, $k) = @_;
    !!($k eq int($k)
        and $k < @{ $self->[IDX_DATA] }
    );
}

sub DELETE
{
    my ($self, $k) = @_;
    return pop @{ $self->[IDX_DATA] }
        if @{ $self->[IDX_DATA] } == $k + 1;
    confess "DELETE not fully implemented";
}

sub CLEAR
{
    my ($self) = @_;
    $self->[IDX_DATA] = [];
}

sub SCALAR
{
    my ($self) = @_;
    my %tmp =
        map { $_ => $self->[IDX_DATA][$_] }
        0 .. $#{ $self->[IDX_DATA] };
    return scalar(%tmp);
}

1;
[download]