File Coverage

blib/lib/Tie/InsertOrderHash.pm

Criterion	Covered	Total	%
statement	34	45	75.5
branch	8	18	44.4
condition			n/a
subroutine	9	12	75.0
pod			n/a
total	51	75	68.0

#
# InsertOrderHash.pm - insert-order-preserving tied hash
#
# $Id$
#

package Tie::InsertOrderHash;

use v5.6.1;
use strict;
use warnings;

our $VERSION = '0.01';

use base qw(Tie::Hash);

sub TIEHASH  { my $c = shift;
	       bless [[@_[grep { $_ % 2 == 0 } (0..$#_)]], {@_}, 0], $c }

sub STORE    { @{$_[0]->[0]} = grep { $_ ne $_[1] } @{$_[0]->[0]};
	       push @{$_[0]->[0]}, $_[1];
	       $_[0]->[2] = -1;
	       $_[0]->[1]->{$_[1]} = $_[2] }

sub FETCH    { $_[0]->[1]->{$_[1]} }

sub FIRSTKEY { return wantarray ? () : undef
		 unless exists $_[0]->[0]->[$_[0]->[2] = 0];
	       my $key = $_[0]->[0]->[0];
	       return wantarray ? ($key, $_[0]->[1]->{$key}) : $key }

# Guard against deletion (see perldoc -f each)
sub NEXTKEY  { my $i = $_[0]->[2];
	       return wantarray ? () : undef unless exists $_[0]->[0]->[$i];
	       if ($_[0]->[0]->[$i] eq $_[1]) {
		 $i = ++$_[0]->[2] ;
		 return wantarray ? () : undef
		   unless exists $_[0]->[0]->[$i];
	       }
	       my $key = ${$_[0]->[0]}[$i];
	       return wantarray ? ($key, $_[0]->[1]->{$key}) : $key }

sub EXISTS   { exists $_[0]->[1]->{$_[1]} }

sub DELETE   { @{$_[0]->[0]} = grep { $_ ne $_[1] } @{$_[0]->[0]};
	       delete $_[0]->[1]->{$_[1]} }

sub CLEAR    { @{$_[0]->[0]} = ();
	       %{$_[0]->[1]} = () }

1;

__END__