File Coverage

blib/lib/Tie/DxHash.pm

Criterion	Covered	Total	%
statement	82	82	100.0
branch	12	12	100.0
condition	2	2	100.0
subroutine	15	15	100.0
pod			n/a
total	111	111	100.0

# $Id $
# $Revision 1.03 $

package Tie::DxHash;

use warnings;
use strict;
use base qw(Tie::Hash);

use Tie::Hash;

our $VERSION = '1.03';

sub CLEAR {
    my ($self) = @_;

    my $test;

    $self->{data}        = [];
    $self->{iterators}   = {};
    $self->{occurrences} = {};
    $self->_ckey(0);

    return $self;
}

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

    my $offset           = 0;
    my @deleted_elements = ();

ELEMENT:
    while ( $offset < @{ $self->{data} } ) {
        if ( $key eq $self->{data}[$offset]{key} ) {
            push @deleted_elements, $self->{data}[$offset]{value};
            splice @{ $self->{data} }, $offset, 1;
        }
        else {
            $offset++;
        }
    }

    delete $self->{iterators}{$key};
    delete $self->{occurrences}{$key};

    return \@deleted_elements;
}

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

    return exists $self->{occurrences}{$key};
}

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

    my ($dup) = 1;

HASH_KEY:
    foreach my $offset ( 0 .. @{ $self->{data} } - 1 ) {
        next HASH_KEY if $key ne $self->{data}[$offset]{key};
        next HASH_KEY if $dup++ != $self->{iterators}{$key};
        $self->{iterators}{$key}++;

        if ( $self->{iterators}{$key} > $self->{occurrences}{$key} ) {
            $self->{iterators}{$key} = 1;
        }

        return $self->{data}[$offset]{value};
    }

    return;
}

sub FIRSTKEY {
    my ($self) = @_;

    $self->_ckey(0);
    return $self->NEXTKEY;
}

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

    my ($ckey) = $self->_ckey;

    if ( $ckey == @{ $self->{data} } ) {
        return;
    }
    else {
        $self->_ckey( $ckey + 1 );
        return $self->{data}[$ckey]{key};
    }
}

sub SCALAR {
    my ($self) = @_;

    my $hash_size = 0;

HASH_KEY:
    foreach my $key ( keys %{ $self->{occurrences} } ) {
        $hash_size += $self->{occurrences}{$key};
    }

    return $hash_size;
}

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

    push @{ $self->{data} }, { key => $key, value => $value };
    $self->{iterators}{$key} ||= 1;
    $self->{occurrences}{$key}++;

    return $self;
}

sub TIEHASH {
    my ( $class, @args ) = @_;

    my ($self);

    $self = {};
    bless $self, $class;

    $self->_init(@args);
    return $self;
}

sub _ckey {
    my ( $self, $ckey ) = @_;

    if ( defined $ckey ) {
        $self->{ckey} = $ckey;
    }
    return $self->{ckey};
}

sub _init {
    my ( $self, @args ) = @_;

    $self->CLEAR;

    while ( my ( $key, $value ) = splice @args, 0, 2 ) {
        $self->STORE( $key, $value );
    }

    return $self;
}

1;    # Magic true value required at end of module
__END__