package Tie::SortHash;
use strict;

use constant HASH    => 0;
use constant LOOKUP  => 1;
use constant ARRAY   => 2;
use constant SUB     => 3;
use constant EVAL    => 4;
use constant CHANGED => 5;

use vars qw($VERSION);

$VERSION = '1.02';

sub TIEHASH {
    my $class = shift;
    my $hash = shift || {};
    my $sort = shift || sub {
        my $hash = shift;
        sort {$a cmp $b || $a <=> $b} keys %$hash;
    };
    my $self = bless [], $class;
    $self->_Build($hash, $sort);
    return $self;
}

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

sub STORE {
    my($self, $key, $value) = @_;
    $self->[HASH]{$key} = $value;
    $self->[CHANGED] = 1;
}

sub EXISTS {
    my($self, $key) = @_;
    return exists $self->[HASH]{$key};
}

sub DELETE {
    my($self, $key) = @_;
    delete $self->[HASH]{$key};
    splice(@{$self->[ARRAY]}, $self->[LOOKUP]{$key}, 1);
    delete $self->[LOOKUP]{$key};
}

sub FIRSTKEY {
    my $self = shift;
    $self->_ReOrder if $self->[CHANGED];
    $self->_Iterate;
}

sub NEXTKEY {
    my ($self, $lastkey) = @_;
    $self->_ReOrder if $self->[CHANGED];
    $self->_Iterate($self->[LOOKUP]{$lastkey});
}

sub CLEAR {
    my $self = shift;
    $self->[HASH] = {};
    $self->[CHANGED] = 1;
}

sub DESTROY {
}

sub _Build {
    my ($self, $hash, $sort) = @_;
    @{$self->[HASH]}{keys %$hash} = values %$hash;
    $self->sortblock($sort);
    $self->_ReOrder;
}

sub _ReOrder {
    my $self = shift;
    $self->[LOOKUP] = ();
    $self->[ARRAY] = ();
    my $index = 0;
    my $hash = $self->[HASH];
    for my $key ($self->[SUB] ? $self->[SUB]($hash) : eval $self->[EVA
+L]) {
        $self->[LOOKUP]{$key} = $index;
        $self->[ARRAY][$index] = $key;
        $index++;
    } 
    $self->[CHANGED] = 0;
}

sub _Iterate {
    my ($self, $index) = @_;
    $index = -1 unless defined $index;
    $index++;
    defined $self->[ARRAY][$index] ? $self->[ARRAY][$index] : undef;
}

sub sortblock {
    my($self, $sort) = @_;
    if (ref $sort eq 'CODE') {
        $self->[SUB] = $sort;
    }
    else {
        my $hash = $self->[HASH];
        $sort =~ s/\$hash/\$hash->/g;
        $self->[EVAL] = "sort { $sort } keys %\$hash";
        eval $self->[EVAL];
        die $@ if $@;
    }
    $self->[CHANGED] = 1;
}

1;
[download]