Re: Any Point in Uploading Tie::SortedHash

All:
After Abigail's response, I realized that of my 3 optimization methods, only 1 of them worked correctly according to the docs for each. perldoc -f each says that it is safe to delete the last key visited while iterating over the keys in an each loop.

It was easy to go from 1/3 to 2/3 working by simply changing the "optimization" for delete. This only left the exponential loop to deal with. The reason for this optimization was to save memory (an extra array and hash).

Since the foreach loop constructs a list the same size as the array anyway, the only real saving of this method was not using the lookup hash. I figured out a way to:

Drop the (n² + n)/2 loop by avoiding the lookup hash

Make the code cleaner

Function properly (I hope)

Be more memory/speed efficient

#!/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()>.
[download]

Cheers - L~R

Comment on Re: Any Point in Uploading Tie::SortedHash Download Code


more useful options
	PerlMonks