File Coverage

blib/lib/Tie/Hash/Sorted.pm

Criterion	Covered	Total	%
statement	113	114	99.1
branch	14	16	87.5
condition	9	9	100.0
subroutine	31	32	96.8
pod	4	4	100.0
total	171	175	97.7

package Tie::Hash::Sorted;
require 5.005_03;
use strict;
use Carp;
use vars '$VERSION';
use UNIVERSAL 'isa';

use constant FIRST_KEY     => -1;
use constant STORED_HASH   =>  0;
use constant ITERATOR      =>  1;
use constant SORTED_KEYS   =>  2;
use constant SORT_ROUTINE  =>  3;
use constant STORE_ROUTINE =>  4;
use constant CHANGED       =>  5;
use constant OPTIMIZATION  =>  6;

$VERSION = '0.10';

BEGIN { *NEXTKEY = \&_FetchKey };

sub TIEHASH {
    my $class = shift;
    croak "Incorrect number of parameters" if @_ % 2;
    my $self = bless [], $class;
    $self->_Build(@_);
    return $self;
}

sub FETCH {
    my($self, $key) = @_;
    return $self->[STORED_HASH]{$key};
}

sub STORE {
    my ($self, $key, $value) = @_;
    $self->[STORE_ROUTINE]{$self->[OPTIMIZATION]}->($self, $key, $value);
    return;
}

sub EXISTS {
    my($self, $key) = @_;
    return exists $self->[STORED_HASH]{$key};
}

sub DELETE {
    my($self, $key) = @_;
    if (exists $self->[STORED_HASH]{$key}) {
        $self->[CHANGED] = 1;
        return delete $self->[STORED_HASH]{$key};
    }
    return undef;
}

sub FIRSTKEY {
    my $self = shift;
    $self->_ReOrder if $self->[OPTIMIZATION] eq 'none' || $self->[CHANGED];
    $self->[ITERATOR] = FIRST_KEY;
    return $self->_FetchKey;
}

sub CLEAR {
    my $self = shift;
    %{$self->[STORED_HASH]} = ();
    @{$self->[SORTED_KEYS]} = ();
    $self->[CHANGED] = 1;
    return;
}

sub DESTROY {
    return;
}

sub Sort_Routine {
    my ($self, $sort) = @_;
    croak "Not a code ref" if ! isa($sort, 'CODE');
    $self->[SORT_ROUTINE] = $sort;
    $self->[CHANGED] = 1;
    return;
}

sub Optimization {
    my ($self, $type) = @_;
    $type ||= 'default';
    croak "Invalid optimization type"
        if $type !~ /^(?:default|none|keys|values)$/;
    $self->[OPTIMIZATION] = $type;
    $self->[CHANGED] = 1;
}

sub Resort {
    my $self = shift;
    $self->[CHANGED] = 1;
    return;
}

sub Count {
    my $self = shift;
    return scalar keys %{$self->[STORED_HASH]};
}

sub _Build {
    my ($self, %opt) = @_;
    my $sort = $opt{Sort_Routine} || sub {
        my $hash = shift;
        [ sort {$a cmp $b || $a <=> $b} keys %$hash ];
    };

    $self->Sort_Routine($sort);
    $self->Optimization($opt{Optimization});

    my $hash = $opt{Hash} || {};
    croak "$hash is not a hash ref" if ! isa($hash, 'HASH');
    @{$self->[STORED_HASH]}{keys %$hash} = values %$hash;

    $self->[STORE_ROUTINE] = {
        'default' => \&_Store_NoOpt,
        'none'    => \&_Store_NoOpt,
        'keys'    => \&_Store_KeyOpt,
        'values'  => \&_Store_ValueOpt
    };
    return;
}

sub _ReOrder {
    my $self = shift;
    $self->[SORTED_KEYS] = $self->[SORT_ROUTINE]->($self->[STORED_HASH]);
    $self->[CHANGED] = 0;
    return;
}

sub _FetchKey {
    my ($self, $lastkey) = @_;
    $self->[ITERATOR]++;
    return $self->[SORTED_KEYS][$self->[ITERATOR]];
}

sub _Store_KeyOpt {
    my($self, $key, $value) = @_;
    $self->[CHANGED] = 1 if ! exists $self->[STORED_HASH]{$key};
    $self->[STORED_HASH]{$key} = $value;
    return;
}

sub _Store_ValueOpt {
    my($self, $key, $value) = @_;
    $self->[CHANGED] = 1 if $value ne $self->[STORED_HASH]{$key};
    $self->[STORED_HASH]{$key} = $value;
    return;
}

sub _Store_NoOpt {
    my($self, $key, $value) = @_;
    $self->[STORED_HASH]{$key} = $value;
    $self->[CHANGED] = 1;
    return;
}

1;
__END__