view release on metacpan or  search on metacpan

lib/Hash/Ordered.pm  view on Meta::CPAN

use 5.006;
use strict;
use warnings;

package Hash::Ordered;
# ABSTRACT: A fast, pure-Perl ordered hash class

our $VERSION = '0.014';

use Carp ();

use constant {
    _DATA => 0, # unordered data
    _KEYS => 1, # ordered keys
    _INDX => 2, # index into _KEYS (on demand)
    _OFFS => 3, # index offset for optimized shift/unshift
    _GCNT => 4, # garbage count
    _ITER => 5, # for tied hash support
};

use constant {
    _INDEX_THRESHOLD => 25, # max size before indexing/tombstone deletion
    _TOMBSTONE       => \1, # ref to arbitrary scalar
};

# 'overloading.pm' not available until 5.10.1 so emulate with Scalar::Util
BEGIN {
    if ( $] gt '5.010000' ) {
        ## no critic
        eval q{
            sub _stringify { no overloading; "$_[0]" }
            sub _numify { no overloading; 0+$_[0] }
        };
        die $@ if $@;       # uncoverable branch true
    }
    else {
        ## no critic
        eval q{
            require Scalar::Util;
            sub _stringify { sprintf("%s=ARRAY(0x%x)",ref($_[0]),Scalar::Util::refaddr($_[0])) }
            sub _numify { Scalar::Util::refaddr($_[0]) }
        };
        die $@ if $@;       # uncoverable branch true
    }
}

use overload
  q{""}    => \&_stringify,
  q{0+}    => \&_numify,
  q{bool}  => sub { !!scalar %{ $_[0]->[_DATA] } },
  fallback => 1;

#pod =method new
#pod
#pod     $oh = Hash::Ordered->new;
#pod     $oh = Hash::Ordered->new( @pairs );
#pod
#pod Constructs an object, with an optional list of key-value pairs.
#pod
#pod The position of a key corresponds to the first occurrence in the list, but
#pod the value will be updated if the key is seen more than once.
#pod
#pod Current API available since 0.009.
#pod
#pod =cut

sub new {
    my $class = shift;

    Carp::croak("new() requires key-value pairs") unless @_ % 2 == 0;

    my ( %data, @keys, $k );
    while (@_) {
        # must stringify keys for _KEYS array
        $k = shift;
        push @keys, "$k" unless exists $data{$k};
        $data{$k} = shift;
    }
    return bless [ \%data, \@keys, undef, 0, 0 ], $class;
}

#pod =method clone
#pod
#pod     $oh2 = $oh->clone;
#pod     $oh2 = $oh->clone( @keys );
#pod
#pod Creates a shallow copy of an ordered hash object.  If no arguments are
#pod given, it produces an exact copy.  If a list of keys is given, the new