File Coverage

blib/lib/Tie/SortHash.pm

Criterion	Covered	Total	%
statement	24	60	40.0
branch	1	10	10.0
condition	2	9	22.2
subroutine	4	13	30.7
pod	1	2	50.0
total	32	94	34.0

package Tie::SortHash;

use strict;
use vars qw($VERSION);

$VERSION = '1.01';

sub iterate {
  my( $hash, $sort, $lastkey ) = @_;
  my $iwantthis                = 0;

  # Iterate over sort order keys until we find what we want
  foreach my $key ( eval "sort { $sort } keys %{\$hash}" ) {

    return( $hash->{$key}, $key ) if $iwantthis || ! defined $lastkey;

    $iwantthis = 1 if $key eq $lastkey;
  }

  # If our sort block is screwed up, report
  die $@ if $@;

  # We ran out of keys.
  return undef;
} ## iterate()

sub sortblock {
  my( $self, $sort ) = @_;

  # Change default syntax to OO version
  $sort =~ s/\$hash/\$hash->/gso;

  # Test the sort block
  my $hash = $self->{DATA};
  my @keys = eval "sort { $sort } keys %{\$hash}";

  # If there's an error, freak out
  die $@ if $@;

  $self->{SORT} = $sort;

  return 1;
} ## sortblock()

sub TIEHASH {
  my $class = shift;

  my $hash  = shift || {};

  # If there's no sort block, supply a good default,
  # that's what this module's for, right?
  my $sort  = shift || '$a cmp $b || $a <=> $b';

  my( $keys, $vals, $i ) = ( {}, [], 1 );

  # Iterate over the hash, setting up info for the pheudo-hash
  foreach my $key ( keys %{$hash} ) {
    $keys->{$key} = $i;
    push @{$vals}, $hash->{$key};
    $i++;
  }

  # Declare the data
  my $self = {
              DATA => [
                       $keys,
                       @{$vals},
                      ],
             };

  # Add our sort block to the data
  sortblock( $self, $sort );

  return bless $self, $class;
} # TIEHASH()

sub CLEAR {
  my $self      = shift;
  return $self->{DATA} = [{}];
} # CLEAR()

sub DELETE {
  my( $self, $key ) = @_;

  # Perl's garbage collection for Phseudo-Hashes stinks,
  # I'm manually taking care of it, forcing me to _not_ be lazy

  # Find the index of the key to delete.
  my $index = $self->{DATA}->[0]->{$key};

  # Decrement all indexes higher than the one we'll delete
  foreach ( keys %{$self->{DATA}} ) {
    $self->{DATA}->[0]->{$_}-- if $self->{DATA}->[0]->{$_} > $index;
  }

  # Remove the value from the array
  splice @{$self->{DATA}}, $index, 1;

  # Delete the key pointing to the just removed value
  return delete $self->{DATA}->[0]->{$key};
} # DELETE()

sub DESTROY {
  # Nothing useful to do here, just commenting about that
} # DESTROY()

sub EXISTS {
  my( $self, $key ) = @_;
  return exists $self->{DATA}->{$key};
} # EXISTS()

sub FETCH {
  my( $self, $key ) = @_;
  return $self->{DATA}->{$key};
} # FETCH()

sub FIRSTKEY {
  my $self = shift;
  keys %{$self->{DATA}};
  return iterate( $self->{DATA}, $self->{SORT}, undef );
} # FIRSTKEY()

sub NEXTKEY {
  my( $self, $lastkey ) = @_;

  # Return undef if there's nothing left in our hash
  return iterate( $self->{DATA}, $self->{SORT}, $lastkey ) || undef;
} # NEXTKEY()

sub STORE {
  my( $self, $key, $value )  = @_;

  # Add the key entry
  $self->{DATA}->[0]->{$key} = @{$self->{DATA}};

  # Add the value
  $self->{DATA}->{$key}      = $value;

  return 1;
} # STORE()

1;

__END__