#!/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 sorted order. It is often frustrating to have a hash return elements in a seemingly random order when using C, C or C.