#!/usr/bin/perl -w
package Tie::SortedHash;
use strict;
use Carp;

use constant HASH    => 0;
use constant LOOKUP  => 1;
use constant ARRAY   => 2;
use constant SORT    => 3;
use constant CHANGED => 4;
use constant OPT     => 5;

our $VERSION = '1.00';

sub TIEHASH {
    my $class = shift;
    croak "Incorrect number of parameters" if @_ % 2;
    my %options = @_;
    my $self = bless [], $class;
    $self->_Build(\%options);
    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) = @_;
    exists $self->[HASH]{$key};
}

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

sub FIRSTKEY {
    my $self = shift;
    $self->_ReOrder if $self->[OPT] == 1 || ($self->[OPT] == 2 && $sel
+f->[CHANGED]);
    $self->_Iterate;
}

sub NEXTKEY {
    my ($self, $lastkey) = @_;
    $self->_Iterate($lastkey);
}

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

sub DESTROY {
}

sub _Build {
    my ($self, $opt) = @_;
    my $sort = exists $opt->{SORT} ? $opt->{SORT} : sub {
        my $hash = shift;
        sort {$a cmp $b || $a <=> $b} keys %$hash;
    };
    $self->sortroutine($sort);
    
    my $hash = exists $opt->{HASH} ? $opt->{HASH} : {};
    croak "$hash is not a hash ref" unless ref $hash eq 'HASH';
    @{$self->[HASH]}{keys %$hash} = values %$hash;
    
    if (exists $opt->{OPTLEVEL}) {
        croak "$opt->{OPTLEVEL} is not valid optimization level" if $o
+pt->{OPTLEVEL} !~ /^[123]$/;
        $self->[OPT] = $opt->{OPTLEVEL};
    }
    else {
        $self->[OPT] = 1;
    }
}

sub _ReOrder {
    my $self = shift;
    $self->[LOOKUP] = ();
    $self->[ARRAY] = ();
    my $index = 0;
    for my $key ($self->[SORT]($self->[HASH])) {
        $self->[LOOKUP]{$key} = $index;
        $self->[ARRAY][$index] = $key;
        $index++;
    }
    $self->[CHANGED] = 0;
}

sub _Iterate {
    my ($self, $lastkey) = @_;    
    unless ($self->[OPT] == 3) {
                my $index = defined $lastkey ? $self->[LOOKUP]{$lastke
+y} : -1;
        $index++;
        return defined $self->[ARRAY][$index] ? $self->[ARRAY][$index]
+ : undef;
    }
    else {
        my $match;
        for my $key ($self->[SORT]($self->[HASH])) {                  
+      
            return $key if $match || ! defined $lastkey;
            $match = 1 if $key eq $lastkey;
        }
    }
    return undef;
}

sub sortroutine {
    my($self, $sort) = @_;
    croak "$sort is not a code ref" unless ref $sort eq 'CODE';
    $self->[SORT] = $sort;
    $self->[CHANGED] = 1;
}

1;
__END__
=head1 NAME

Tie::HashSort - Perl module to get hash keys in a sorted order

=head1 SYNOPSIS
    use Tie::HashSort;

    my %hash = (
        'John'   => 33,
        'Jacob'  => 29,
        'Jingle' => 15,
        'Heimer' => 48,
        'Smitz'  => 12,
    );

    my $sort = sub {
        my $hash = shift;
        sort {$hash->{$b} <=> $hash->{$a}} keys %$hash;
    };

    tie my %sorted_hash, 'Tie::SortedHash', 'HASH' => \%hash, 'SORT' =
+> $sort, 'OPTLEVEL' => 2;

    for my $name ( keys %sorted_hash ) {
        print "$name is $hash{$name} ears old.\n";
    }

    ### OUTPUT ###
    Heimer is 48 ears old.
    John is 33 ears old.
    Jacob is 29 ears old.
    Jingle is 15 ears old.
    Smitz is 12 ears old.

=head1 DESCRIPTION

This module is a designed to retrieve hash keys in a pre-defined sorte
+d order.
It is often frustrating to have a hash return elements in a seemingly 
+random order 
when using C<keys()>, C<values()> or C<each()>.
[download]