File Coverage

blib/lib/Tie/Hash/Rank.pm

Criterion	Covered	Total	%
statement	38	46	82.6
branch	6	8	75.0
condition			n/a
subroutine	9	11	81.8
pod			n/a
total	53	65	81.5

package Tie::Hash::Rank;

use strict;

my $VERSION='1.0.1';

sub TIEHASH {
	my $class = shift;
	my $self = {
		ALGORITHM	=> '$DATA{$b} <=> $DATA{$a}', # rev numeric sort
		EQUALITYSUFFIX	=> '',
		EQUALITYPREFIX	=> '',
		RECALCULATE	=> 'onstore',
		@_,
		_RANKS		=> {},   # yes, these go AFTER the parameters
		DATA		=> {}
	};

	return bless $self, $class;
}

sub _recalculate {
	my $self = shift;
	my $sort_function = $self->{ALGORITHM};
	$sort_function=~s/\$DATA\{(\$[ab])\}/\$self->{DATA}->{$1}/g;
	$self->{_RANKS} = {};
	my $i=1;
	my $prevkey;
	foreach my $key (
		eval("sort { $sort_function } keys %{\$self->{DATA}}")
	) {
		$self->{_RANKS}->{$key}=$i++;

		no warnings; # to avoid 'use of uninitialised value' errors
			     # in next line

		if($self->{DATA}->{$key} eq $self->{DATA}->{$prevkey}) {
			$self->{_RANKS}->{$key} =
			  $self->{_RANKS}->{$prevkey} =
			    $self->{EQUALITYPREFIX}.
			    $self->{_RANKS}->{$prevkey}.
			    $self->{EQUALITYSUFFIX};
		}
		$prevkey = $key;
	}
}

sub CLEAR { my $self=shift; $self->{DATA}={}; $self->{_RANKS}={}; }
sub STORE {
        my($self, $key, $value)=@_;
        $self->{DATA}->{$key}=$value;
	$self->_recalculate() if($self->{RECALCULATE} eq 'onstore');
}
sub FETCH {
        my $self=shift;
        my $key=shift;
	$self->_recalculate() if($self->{RECALCULATE} eq 'onfetch');
	return $self->{_RANKS}->{$key};
}
sub FIRSTKEY {
	my $self = shift;
	scalar keys %{$self->{DATA}};
	return scalar each %{$self->{DATA}};
}
sub NEXTKEY {
	my $self = shift;
	return scalar each %{$self->{DATA}};
}
sub DELETE {
	my $self = shift;
	my $key = shift;
	delete $self->{_RANKS}->{$key};
	delete $self->{DATA}->{$key};
	$self->_recalculate() if($self->{RECALCULATE} eq 'onstore');
}
sub EXISTS {
	my $self = shift;
	my $key = shift;
	return exists($self->{DATA}->{$key});
}

1;
__END__