#!/usr/bin/perl -w
package Tie::SortedHash;
use strict;
use Carp;
use constant HASH => 0;
use constant INDEX => 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};
$self->[CHANGED] = 1;
}
sub FIRSTKEY {
my $self = shift;
$self->_ReOrder if ! $self->[OPT] || $self->[CHANGED];
$self->[INDEX] = -1;
$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" if ref $hash ne 'HASH';
@{$self->[HASH]}{keys %$hash} = values %$hash;
$self->[OPT] = $opt->{OPT} if exists $opt->{OPT};
}
sub _ReOrder {
my $self = shift;
@{$self->[ARRAY]} = $self->[SORT]($self->[HASH]);
$self->[CHANGED] = 0;
}
sub _Iterate {
my ($self, $lastkey) = @_;
$self->[INDEX]++;
$self->[ARRAY][$self->[INDEX]];
}
sub sortroutine {
my($self, $sort) = @_;
croak "$sort is not a code ref" if ref $sort ne '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, 'OPT' => 1;
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()>.