doubly-linked list, pure-Perl ordered hash implementation

bench.pl

#!/usr/bin/env perl

# based on bench.pl with modifications to benchmark 1 million+ keys
# https://github.com/mhx/Tie-Hash-Indexed/blob/master/devel/bench.pl

use strict;
use warnings;

use List::Util 'shuffle';
use Benchmark;

#use Tie::IxHash;  # not tested below due to 1 million+ taking a long time
use Tie::Hash::Indexed;
use MCE::Shared::Indhash;
use MCE::Shared::Ordhash;
use Hash::Ordered;

srand 42;

my @words = shuffle map { chomp; $_ } <DATA>;
my @list  = map { ( $_ => $_ ) } @words;

# after loop, @words contains 1,280,000 unique keys

for my $c ( 2 .. 7 ) {
  my @temp = map { "$_$c" } @words;
  push @list, map { ( "$_$c" => "$_$c" ) } @temp;
  push @words, @temp;
}

$| = 1; print "\n";

do_benchmark($_) for qw(
  Tie::Hash::Indexed MCE::Shared::Indhash MCE::Shared::Ordhash Hash::Ordered
);

sub do_benchmark
{
  my $module = shift;
  tie my(%h), $module;

  print "# $module\n";

  timethese( 1, {
    a_listassign     => sub {
                          %h = @list;
                        },
    b_clear          => sub {
                          %h = ();
                        },
    c_store_new      => sub {
                          for my $w ( @words ) {
                            $h{$w} = $w;
                          }
                        },
    d_store_existing => sub {
                          for my $w ( @words ) {
                            $h{$w} = $w;
                          }
                        },
    e_exists         => sub {
                          for my $w ( @words ) {
                            exists $h{$w} or die;
                          }
                        },
    f_fetch          => sub {
                          for my $w ( @words ) {
                            $h{$w} or die;
                          }
                        },
    g_keys           => sub {
                          my @k = keys %h;
                        },
    h_values         => sub {
                          my @v = values %h;
                        },
    i_each           => sub {
                          while( my($k,$v) = each %h ) { }
                        },
    j_delete         => sub {
                          for my $w ( @words ) {
                            delete $h{$w} or die;
                          }
                        },
  });

  print "\n";
}

# 20000 words following...

__DATA__
...

bench_oh.pl

#!/usr/bin/env perl

use strict;
use warnings;

use List::Util 'shuffle';
use Time::HiRes 'time';

use Tie::Hash::Indexed;
use MCE::Shared::Indhash;
use MCE::Shared::Ordhash;
use Hash::Ordered;

srand 1618;

my $c = shift || 1;  # (1) Tie::Hash::Indexed
                     # (2) MCE::Shared::Indhash
                     # (3) MCE::Shared::Ordhash
                     # (4) Hash::Ordered

my $max  = 1_000_000;
my @rand = shuffle(1..$max);

my $oh1  = tie my %h1, 'Tie::Hash::Indexed';
my $oh2  = tie my %h2, 'MCE::Shared::Indhash';
my $oh3  = tie my %h3, 'MCE::Shared::Ordhash';
my $oh4  = tie my %h4, 'Hash::Ordered';
my $oh;

if    ($c eq '1') { print ref($oh1), "\n"; $oh = $oh1 }
elsif ($c eq '2') { print ref($oh2), "\n"; $oh = $oh2 }
elsif ($c eq '3') { print ref($oh3), "\n"; $oh = $oh3 }
elsif ($c eq '4') { print ref($oh4), "\n"; $oh = $oh4 }
else              { print "usage: $0 [ 1 | 2 | 3 | 4 ]\n" }

my $s = time;
$oh->STORE($_,$_) for 1..$max;
printf "store  : %0.3f secs.\n", time - $s;

my $d = time;
$oh->DELETE($_) for @rand;
printf "delete : %0.3f secs.\n", time - $d;

printf "elapse : %0.3f secs.\n", time - $s;
print  "\n";

__END__

$ perl bench_oh.pl 1
Tie::Hash::Indexed
store  : 0.858 secs.
delete : 1.544 secs.
elapse : 2.401 secs.

$ perl bench_oh.pl 2
MCE::Shared::Indhash
store  : 1.271 secs.
delete : 2.197 secs.
elapse : 3.468 secs.

$ perl bench_oh.pl 3
MCE::Shared::Ordhash
store  : 1.048 secs.
delete : 2.829 secs.
elapse : 3.877 secs.

$ perl bench_oh.pl 4
Hash::Ordered
store  : 1.076 secs.
delete : 4.037 secs.
elapse : 5.113 secs.

bench_oo.pl

#!/usr/bin/env perl

# based on bench.pl with modifications to benchmark 1 million+ keys
# https://github.com/mhx/Tie-Hash-Indexed/blob/master/devel/bench.pl

use strict;
use warnings;

use List::Util 'shuffle';
use Benchmark;

#use Tie::IxHash;  # not tested below due to 1 million+ taking a long time
use Tie::Hash::Indexed;
use MCE::Shared::Indhash;
use MCE::Shared::Ordhash;
use Hash::Ordered;

srand 42;

my @words = shuffle map { chomp; $_ } <DATA>;
my @list  = map { ( $_ => $_ ) } @words;

# after loop, @words contains 1,280,000 unique keys

for my $c ( 2 .. 7 ) {
  my @temp = map { "$_$c" } @words;
  push @list, map { ( "$_$c" => "$_$c" ) } @temp;
  push @words, @temp;
}

$| = 1; print "\n";

do_benchmark($_) for qw(
  Tie::Hash::Indexed MCE::Shared::Indhash MCE::Shared::Ordhash Hash::Ordered
);

sub do_benchmark
{
  my $module = shift;
  my $oh = eval qq{ $module->new() };

  print "# $module\n";

  timethese( 1, {
    a_listassign     => sub {
                          $oh->merge(@list);
                        },
    b_clear          => sub {
                          $oh->clear();
                        },
    c_store_new      => sub {
                          for my $w ( @words ) {
                            $oh->set($w,$w);
                          }
                        },
    d_store_existing => sub {
                          for my $w ( @words ) {
                            $oh->set($w,$w);
                          }
                        },
    e_exists         => sub {
                          for my $w ( @words ) {
                            $oh->exists($w) or die;
                          }
                        },
    f_fetch          => sub {
                          for my $w ( @words ) {
                            $oh->get($w) or die;
                          }
                        },
    g_keys           => sub {
                          my @k = $oh->keys;
                        },
    h_values         => sub {
                          my @v = $oh->values;
                        },
  # i_each           => sub {
  #                       while( my($k,$v) = each %h ) { }
  #                     },
    j_delete         => sub {
                          for my $w ( @words ) {
                            $oh->delete($w) or die;
                          }
                        },
  });

  print "\n";
}

# 20000 words following...

__DATA__
...

bench_oo_pl_results.txt

# bench_oo.pl results

  I ran each module individually to capture memory consumption via UNIX top.

# Tie::Hash::Indexed
   665 MB,  806 MB,  8.286 secs

# MCE::Shared::Indhash
  1149 MB, 1328 MB, 10.555 secs

# MCE::Shared::Ordhash
   627 MB,  813 MB, 10.230 secs

# Hash::Ordered
   628 MB,  815 MB, 12.830 secs

$ perl bench_oo.pl | grep -v "warning: too few iterations for a reliable count"

# Tie::Hash::Indexed
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 0.91 usr +  0.08 sys =  0.99 CPU) @  1.01/s (n=1)
         b_clear:  1 wallclock secs ( 1.17 usr +  0.06 sys =  1.23 CPU) @  0.81/s (n=1)
     c_store_new:  1 wallclock secs ( 0.91 usr +  0.03 sys =  0.94 CPU) @  1.06/s (n=1)
d_store_existing:  1 wallclock secs ( 0.64 usr +  0.00 sys =  0.64 CPU) @  1.56/s (n=1)
        e_exists:  0 wallclock secs ( 0.51 usr +  0.00 sys =  0.51 CPU) @  1.96/s (n=1)
         f_fetch:  1 wallclock secs ( 0.83 usr +  0.00 sys =  0.83 CPU) @  1.20/s (n=1)
          g_keys:  0 wallclock secs ( 0.28 usr +  0.02 sys =  0.30 CPU) @  3.33/s (n=1)
        h_values:  1 wallclock secs ( 0.26 usr +  0.01 sys =  0.27 CPU) @  3.70/s (n=1)
        j_delete:  1 wallclock secs ( 1.30 usr +  0.03 sys =  1.33 CPU) @  0.75/s (n=1)

# MCE::Shared::Indhash
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 1.41 usr +  0.11 sys =  1.52 CPU) @  0.66/s (n=1)
         b_clear:  1 wallclock secs ( 0.77 usr +  0.00 sys =  0.77 CPU) @  1.30/s (n=1)
     c_store_new:  2 wallclock secs ( 1.65 usr +  0.07 sys =  1.72 CPU) @  0.58/s (n=1)
d_store_existing:  1 wallclock secs ( 0.93 usr +  0.00 sys =  0.93 CPU) @  1.08/s (n=1)
        e_exists:  0 wallclock secs ( 0.78 usr +  0.00 sys =  0.78 CPU) @  1.28/s (n=1)
         f_fetch:  1 wallclock secs ( 0.86 usr +  0.00 sys =  0.86 CPU) @  1.16/s (n=1)
          g_keys:  1 wallclock secs ( 0.39 usr +  0.03 sys =  0.42 CPU) @  2.38/s (n=1)
        h_values:  0 wallclock secs ( 0.36 usr +  0.00 sys =  0.36 CPU) @  2.78/s (n=1)
        j_delete:  2 wallclock secs ( 1.73 usr +  0.03 sys =  1.76 CPU) @  0.57/s (n=1)

# MCE::Shared::Ordhash
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 1.07 usr +  0.07 sys =  1.14 CPU) @  0.88/s (n=1)
         b_clear:  1 wallclock secs ( 1.33 usr +  0.04 sys =  1.37 CPU) @  0.73/s (n=1)
     c_store_new:  1 wallclock secs ( 1.32 usr +  0.02 sys =  1.34 CPU) @  0.75/s (n=1)
d_store_existing:  1 wallclock secs ( 0.95 usr +  0.00 sys =  0.95 CPU) @  1.05/s (n=1)
        e_exists:  1 wallclock secs ( 0.70 usr +  0.00 sys =  0.70 CPU) @  1.43/s (n=1)
         f_fetch:  1 wallclock secs ( 0.80 usr +  0.00 sys =  0.80 CPU) @  1.25/s (n=1)
          g_keys:  0 wallclock secs ( 0.24 usr +  0.03 sys =  0.27 CPU) @  3.70/s (n=1)
        h_values:  1 wallclock secs ( 0.68 usr +  0.00 sys =  0.68 CPU) @  1.47/s (n=1)
        j_delete:  2 wallclock secs ( 1.72 usr +  0.01 sys =  1.73 CPU) @  0.58/s (n=1)

# Hash::Ordered
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 1.33 usr +  0.07 sys =  1.40 CPU) @  0.71/s (n=1)
         b_clear:  2 wallclock secs ( 1.35 usr +  0.04 sys =  1.39 CPU) @  0.72/s (n=1)
     c_store_new:  1 wallclock secs ( 1.64 usr +  0.04 sys =  1.68 CPU) @  0.60/s (n=1)
d_store_existing:  1 wallclock secs ( 0.98 usr +  0.00 sys =  0.98 CPU) @  1.02/s (n=1)
        e_exists:  1 wallclock secs ( 0.71 usr +  0.00 sys =  0.71 CPU) @  1.41/s (n=1)
         f_fetch:  1 wallclock secs ( 0.77 usr +  0.00 sys =  0.77 CPU) @  1.30/s (n=1)
          g_keys:  0 wallclock secs ( 0.32 usr +  0.02 sys =  0.34 CPU) @  2.94/s (n=1)
        h_values:  1 wallclock secs ( 0.89 usr +  0.01 sys =  0.90 CPU) @  1.11/s (n=1)
        j_delete:  3 wallclock secs ( 3.13 usr +  0.04 sys =  3.17 CPU) @  0.32/s (n=1)

bench_pl_results.txt

# bench.pl results

  I ran each module individually to capture memory consumption via UNIX top.

  The 2nd memory consumption comes from spike seen in g_keys due to
  TIE interface. MCE::Shared::Ordhash has lesser memory consumption
  than Hash::Ordered due to purging tombstones in-place.

# Tie::Hash::Indexed
   981 MB, 1391 MB, 16.809 secs

# MCE::Shared::Indhash
  1340 MB, 1933 MB, 20.937 secs

# MCE::Shared::Ordhash
   904 MB, 1350 MB, 18.909 secs

# Hash::Ordered
   904 MB, 1357 MB, 20.860 secs

$ perl bench.pl | grep -v "warning: too few iterations for a reliable count"

# Tie::Hash::Indexed
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 0.91 usr +  0.08 sys =  0.99 CPU) @  1.01/s (n=1)
         b_clear:  1 wallclock secs ( 1.17 usr +  0.06 sys =  1.23 CPU) @  0.81/s (n=1)
     c_store_new:  1 wallclock secs ( 0.91 usr +  0.03 sys =  0.94 CPU) @  1.06/s (n=1)
d_store_existing:  1 wallclock secs ( 0.64 usr +  0.00 sys =  0.64 CPU) @  1.56/s (n=1)
        e_exists:  0 wallclock secs ( 0.51 usr +  0.00 sys =  0.51 CPU) @  1.96/s (n=1)
         f_fetch:  1 wallclock secs ( 0.83 usr +  0.00 sys =  0.83 CPU) @  1.20/s (n=1)
          g_keys:  0 wallclock secs ( 0.28 usr +  0.02 sys =  0.30 CPU) @  3.33/s (n=1)
        h_values:  1 wallclock secs ( 0.26 usr +  0.01 sys =  0.27 CPU) @  3.70/s (n=1)
        j_delete:  1 wallclock secs ( 1.30 usr +  0.03 sys =  1.33 CPU) @  0.75/s (n=1)

# MCE::Shared::Indhash
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 1.41 usr +  0.11 sys =  1.52 CPU) @  0.66/s (n=1)
         b_clear:  1 wallclock secs ( 0.77 usr +  0.00 sys =  0.77 CPU) @  1.30/s (n=1)
     c_store_new:  2 wallclock secs ( 1.65 usr +  0.07 sys =  1.72 CPU) @  0.58/s (n=1)
d_store_existing:  1 wallclock secs ( 0.93 usr +  0.00 sys =  0.93 CPU) @  1.08/s (n=1)
        e_exists:  0 wallclock secs ( 0.78 usr +  0.00 sys =  0.78 CPU) @  1.28/s (n=1)
         f_fetch:  1 wallclock secs ( 0.86 usr +  0.00 sys =  0.86 CPU) @  1.16/s (n=1)
          g_keys:  1 wallclock secs ( 0.39 usr +  0.03 sys =  0.42 CPU) @  2.38/s (n=1)
        h_values:  0 wallclock secs ( 0.36 usr +  0.00 sys =  0.36 CPU) @  2.78/s (n=1)
        j_delete:  2 wallclock secs ( 1.73 usr +  0.03 sys =  1.76 CPU) @  0.57/s (n=1)

# MCE::Shared::Ordhash
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 1.07 usr +  0.07 sys =  1.14 CPU) @  0.88/s (n=1)
         b_clear:  1 wallclock secs ( 1.33 usr +  0.04 sys =  1.37 CPU) @  0.73/s (n=1)
     c_store_new:  1 wallclock secs ( 1.32 usr +  0.02 sys =  1.34 CPU) @  0.75/s (n=1)
d_store_existing:  1 wallclock secs ( 0.95 usr +  0.00 sys =  0.95 CPU) @  1.05/s (n=1)
        e_exists:  1 wallclock secs ( 0.70 usr +  0.00 sys =  0.70 CPU) @  1.43/s (n=1)
         f_fetch:  1 wallclock secs ( 0.80 usr +  0.00 sys =  0.80 CPU) @  1.25/s (n=1)
          g_keys:  0 wallclock secs ( 0.24 usr +  0.03 sys =  0.27 CPU) @  3.70/s (n=1)
        h_values:  1 wallclock secs ( 0.68 usr +  0.00 sys =  0.68 CPU) @  1.47/s (n=1)
        j_delete:  2 wallclock secs ( 1.72 usr +  0.01 sys =  1.73 CPU) @  0.58/s (n=1)

# Hash::Ordered
Benchmark: timing 1 iterations of a_listassign, b_clear, c_store_new, d_store_existing, e_exists, f_fetch, g_keys, h_values, j_delete...
    a_listassign:  1 wallclock secs ( 1.33 usr +  0.07 sys =  1.40 CPU) @  0.71/s (n=1)
         b_clear:  2 wallclock secs ( 1.35 usr +  0.04 sys =  1.39 CPU) @  0.72/s (n=1)
     c_store_new:  1 wallclock secs ( 1.64 usr +  0.04 sys =  1.68 CPU) @  0.60/s (n=1)
d_store_existing:  1 wallclock secs ( 0.98 usr +  0.00 sys =  0.98 CPU) @  1.02/s (n=1)
        e_exists:  1 wallclock secs ( 0.71 usr +  0.00 sys =  0.71 CPU) @  1.41/s (n=1)
         f_fetch:  1 wallclock secs ( 0.77 usr +  0.00 sys =  0.77 CPU) @  1.30/s (n=1)
          g_keys:  0 wallclock secs ( 0.32 usr +  0.02 sys =  0.34 CPU) @  2.94/s (n=1)
        h_values:  1 wallclock secs ( 0.89 usr +  0.01 sys =  0.90 CPU) @  1.11/s (n=1)
        j_delete:  3 wallclock secs ( 3.13 usr +  0.04 sys =  3.17 CPU) @  0.32/s (n=1)

Indhash.pm

###############################################################################
## ----------------------------------------------------------------------------
## A doubly-linked list, pure-Perl ordered hash implementation, inspired by
## the Tie::Hash::Indexed (XS) module. The API resembles MCE::Shared::Ordhash,
## which features an optimized tombstone deletion. Both modules may be used
## interchangeably.
##
## This implementation lacks _find support for ->keys, ->pairs, ->values,
## and ->iterator.
##
###############################################################################

package MCE::Shared::Indhash;

use strict;
use warnings;

no warnings qw( threads recursion uninitialized numeric );

our $VERSION = '1.000';

## no critic (Subroutines::ProhibitExplicitReturnUndef)
## no critic (TestingAndDebugging::ProhibitNoStrict)

use bytes;

use constant { _DATA => 0, _ROOT => 1, _ITER => 2 };              # self
use constant { _KEY  => 0, _VAL  => 1, _PREV => 2, _NEXT => 3 };  # link

###############################################################################
## ----------------------------------------------------------------------------
## TIEHASH, STORE, FETCH, DELETE, FIRSTKEY, NEXTKEY, EXISTS, CLEAR, SCALAR
##
###############################################################################

# TIEHASH ( key, value [, key, value, ... ] )
# TIEHASH ( )

sub TIEHASH {
    my $class = shift;
    my ( %data, @root, $key );

    $root[_KEY ] = $root[_VAL ] = undef;
    $root[_PREV] = $root[_NEXT] = \@root;

    while ( @_ ) {
        $key = shift;
        if ( !exists $data{ $key } ) {
            $root[_PREV] = $root[_PREV][_NEXT] = $data{ $key } = [
                "$key", shift(), $root[_PREV], \@root
            ];
        }
        else {
            $data{ $key }[_VAL] = shift;
        }
    }

    bless [ \%data, \@root ], $class;
}

# STORE ( key, value )

sub STORE {
    my ( $key, $data, $root ) = ( $_[1], @{ $_[0] } );

    if ( my $link = $data->{ $key } ) {
        $link->[_VAL] = $_[2];
    }
    else {
        $root->[_PREV] = $root->[_PREV][_NEXT] = $data->{ $key } = [
            "$key", $_[2], $root->[_PREV], $root
        ];
        $_[2];
    }
}

# FETCH ( key )

sub FETCH {
    if ( my $link = $_[0]->[_DATA]{ $_[1] } ) {
        $link->[_VAL];
    }
    else {
        undef;
    }
}

# DELETE ( key )

sub DELETE {
    if ( my $link = delete $_[0]->[_DATA]{ $_[1] } ) {
        $link->[_PREV][_NEXT] = $link->[_NEXT];
        $link->[_NEXT][_PREV] = $link->[_PREV];

        $link->[_VAL];
    }
    else {
        undef;
    }
}

# FIRSTKEY ( )

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

    $self->[_ITER] = sub {
        return unless @keys;
        return shift  @keys;
    };

    $self->[_ITER]->();
}

# NEXTKEY ( )

sub NEXTKEY {
    $_[0]->[_ITER]->();
}

# EXISTS ( key )

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

# CLEAR ( )

sub CLEAR {
    my ( $self ) = @_;
    my $root = $self->[_ROOT];

    $root->[_PREV] = $root->[_NEXT] = $root;
    %{ $self->[_DATA] } = ();

    delete $self->[_ITER];

    return;
}

# SCALAR ( )

sub SCALAR {
    scalar( keys %{ $_[0]->[_DATA] } );
}

###############################################################################
## ----------------------------------------------------------------------------
## Custom non-recursion freezing/thawing necessary for large hashes.
##
###############################################################################

## for Storable support

sub STORABLE_freeze {
    my ( $self, $cloning ) = @_;
    return if $cloning;

    my $cur = $self->[_ROOT][_NEXT];
    my @pairs;

    for ( 1 .. scalar( keys %{ $self->[_DATA] } ) ) {
        push @pairs, @{ $cur }[ _KEY, _VAL ];
        $cur = $cur->[_NEXT];
    }

    return ( '', \@pairs );
}

sub STORABLE_thaw {
    my ( $self, $cloning, $serialized, $pairs ) = @_;
    return if $cloning;

    my ( %data, @root, $key );

    $root[_KEY ] = $root[_VAL ] = undef;
    $root[_PREV] = $root[_NEXT] = \@root;

    while ( @{ $pairs } ) {
        $key = shift @{ $pairs };
        $root[_PREV] = $root[_PREV][_NEXT] = $data{ $key } = [
            $key, shift(@{ $pairs }), $root[_PREV], \@root
        ];
    }

    $self->[_DATA] = \%data;
    $self->[_ROOT] = \@root;

    delete $self->[_ITER];

    return;
}

## for Sereal support

sub FREEZE {
    my ( $self, $serializer ) = @_;

    my $cur = $self->[_ROOT][_NEXT];
    my @pairs;

    for ( 1 .. scalar( keys %{ $self->[_DATA] } ) ) {
        push @pairs, @{ $cur }[ _KEY, _VAL ];
        $cur = $cur->[_NEXT];
    }

    return \@pairs;
}

sub THAW {
    my ( $class, $serializer, $pairs ) = @_;
    my $self = $class->new();

    my ( %data, @root, $key );

    $root[_KEY ] = $root[_VAL ] = undef;
    $root[_PREV] = $root[_NEXT] = \@root;

    while ( @{ $pairs } ) {
        $key = shift @{ $pairs };
        $root[_PREV] = $root[_PREV][_NEXT] = $data{ $key } = [
            $key, shift(@{ $pairs }), $root[_PREV], \@root
        ];
    }

    $self->[_DATA] = \%data;
    $self->[_ROOT] = \@root;

    return $self;
}

###############################################################################
## ----------------------------------------------------------------------------
## POP, PUSH, SHIFT, UNSHIFT, SPLICE
##
###############################################################################

# POP ( )

sub POP {
    my $self = shift;

    if ( defined ( my $key = $self->[_ROOT][_PREV][_KEY] ) ) {
        my $link = delete $self->[_DATA]{ $key };
        $link->[_PREV][_NEXT] = $link->[_NEXT];
        $link->[_NEXT][_PREV] = $link->[_PREV];

        return $key, $link->[_VAL];
    }

    return;
}

# PUSH ( key, value [, key, value, ... ] )

sub PUSH {
    my $self = shift;
    my ( $data, $root ) = @{ $self };
    my $key;

    while ( @_ ) {
        $key = shift;
        $self->DELETE($key) if ( exists $data->{ $key } );
        $root->[_PREV] = $root->[_PREV][_NEXT] = $data->{ $key } = [
            "$key", shift(), $root->[_PREV], $root
        ];
    }

    scalar( keys %{ $data } );
}

# SHIFT ( )

sub SHIFT {
    my $self = shift;

    if ( defined ( my $key = $self->[_ROOT][_NEXT][_KEY] ) ) {
        my $link = delete $self->[_DATA]{ $key };
        $link->[_PREV][_NEXT] = $link->[_NEXT];
        $link->[_NEXT][_PREV] = $link->[_PREV];

        return $key, $link->[_VAL];
    }

    return;
}

# UNSHIFT ( key, value [, key, value, ... ] )

sub UNSHIFT {
    my $self = shift;
    my ( $data, $root ) = @{ $self };
    my $key;

    while ( @_ ) {
        $key = $_[-2];
        $self->DELETE($key) if ( exists $data->{ $key } );
        $root->[_NEXT] = $root->[_NEXT][_PREV] = $data->{ $key } = [
            "$key", pop(), $root, $root->[_NEXT]
        ];
        pop;
    }

    scalar( keys %{ $data } );
}

# SPLICE ( offset, length [, key, value, ... ] )

sub SPLICE {
    my ( $self, $off ) = ( shift, shift );
    my ( $data, $root ) = @{ $self };
    my ( $cur, $key, @ret );

    return @ret unless ( defined $off );

    my $size = keys %{ $data };
    my $len  = @_ ? shift : $size - $off;

    if ( $off >= $size ) {
        $self->PUSH( @_ ) if @_;
    }
    elsif ( abs($off) <= $size ) {
        $off = -($size - $off) if ( $off > int($size / 2) );

        if ( $off < 0 ) {
            $cur = $root->[_PREV];
            while ( ++$off ) { $cur = $cur->[_PREV]; }
        }
        else {
            $cur = $root->[_NEXT];
            while ( $off-- ) { $cur = $cur->[_NEXT]; }
        }

        if ( $len > 0 ) {
            $cur = $cur->[_PREV];
            while ( $len-- ) {
                $key = $cur->[_NEXT][_KEY];
                last unless ( defined $key );
                push @ret, $key, $self->DELETE($key);
            }
            $cur = $cur->[_NEXT];
        }

        while ( @_ ) {
            $key = shift;
            if ( my $link = $data->{ $key } ) {
                $link->[_VAL] = shift;
            }
            else {
                $cur->[_PREV] = $cur->[_PREV][_NEXT] = $data->{ $key } = [
                    "$key", shift(), $cur->[_PREV], $cur
                ];
            }
        }
    }

    return @ret;
}

###############################################################################
## ----------------------------------------------------------------------------
## clone, flush, iterator, keys, pairs, values
##
###############################################################################

# clone ( key [, key, ... ] )
# clone ( )

sub clone {
    my $self = shift;
    my $params = ref($_[0]) eq 'HASH' ? shift : {};
    my ( %data, @root, $key );

    $root[_KEY ] = $root[_VAL ] = undef;
    $root[_PREV] = $root[_NEXT] = \@root;

    if ( @_ ) {
        while ( @_ ) {
            $key = shift;
            $root[_PREV] = $root[_PREV][_NEXT] = $data{ $key } = [
                "$key", $self->FETCH($key), $root[_PREV], \@root
            ];
        }
    }
    else {
        my $cur = $self->[_ROOT][_NEXT];

        for ( 1 .. scalar( keys %{ $self->[_DATA] } ) ) {
            $key = $cur->[_KEY];
            $root[_PREV] = $root[_PREV][_NEXT] = $data{ $key } = [
                $key, $cur->[_VAL], $root[_PREV], \@root
            ];
            $cur = $cur->[_NEXT];
        }
    }

    $self->clear() if $params->{'flush'};

    bless [ \%data, \@root ], ref $self;
}

# flush ( key [, key, ... ] )
# flush ( )

sub flush {
    shift()->clone( { flush => 1 }, @_ );
}

# iterator ( key [, key, ... ] )
# iterator ( )

sub iterator {
    my ( $self, @keys ) = @_;
    my $data = $self->[_DATA];

    if ( !scalar @keys ) {
        @keys = $self->keys();
    }

    return sub {
        return unless @keys;
        my $key = shift @keys;

        return ( exists $data->{ $key } )
           ? ( $key => $data->{ $key }[_VAL] )
           : ( $key => undef )
    };
}

# keys ( key [, key, ... ] )
# keys ( )

sub keys {
    my $self = shift;

    if ( wantarray ) {
        my $cur = $self->[_ROOT][_NEXT];
        @_ ? map { exists $self->[_DATA]{ $_ } ? $_ : undef } @_
           : map { ( $cur = $cur->[_NEXT] )->[_PREV][_KEY] }
                1 .. scalar( CORE::keys %{ $self->[_DATA] } );
    }
    else {
        scalar( CORE::keys %{ $self->[_DATA] } );
    }
}

# pairs ( key [, key, ... ] )
# pairs ( )

sub pairs {
    my $self = shift;

    if ( wantarray ) {
        my $cur = $self->[_ROOT][_NEXT];
        @_ ? map { $_ => $self->FETCH($_) } @_
           : map { @{ ( $cur = $cur->[_NEXT] )->[_PREV] }[ _KEY, _VAL ] }
                1 .. scalar( CORE::keys %{ $self->[_DATA] } );
    }
    else {
        CORE::keys %{ $self->[_DATA] };
    }
}

# values ( key [, key, ... ] )
# values ( )

sub values {
    my $self = shift;

    if ( wantarray ) {
        my $cur = $self->[_ROOT][_NEXT];
        @_ ? map { $self->FETCH($_) } @_
           : map { ( $cur = $cur->[_NEXT] )->[_PREV][_VAL] }
                1 .. scalar( CORE::keys %{ $self->[_DATA] } );
    }
    else {
        scalar( CORE::keys %{ $self->[_DATA] } );
    }
}

###############################################################################
## ----------------------------------------------------------------------------
## mdel, mexists, mget, mset, sort
##
###############################################################################

# mdel ( key [, key, ... ] )

sub mdel {
    my $self = shift;
    my ( $data, $cnt, $key ) = ( $self->[_DATA], 0 );

    while ( @_ ) {
        $key = shift;
        $cnt++, $self->DELETE($key) if ( exists $data->{ $key } );
    }

    $cnt;
}

# mexists ( key [, key, ... ] )

sub mexists {
    my $self = shift;
    my $data = $self->[_DATA];
    my $key;

    while ( @_ ) {
        $key = shift;
        return '' unless ( exists $data->{ $key } );
    }

    1;
}

# mget ( key [, key, ... ] )

sub mget {
    my $self = shift;

    @_ ? map { defined $_ ? $_->[_VAL] : undef } @{ $self->[_DATA] }{ @_ }
       : ();
}

# mset ( key, value [, key, value, ... ] )

sub mset {
    my $self = shift;
    my ( $data, $root ) = @{ $self };
    my $key;

    while ( @_ ) {
        $key = shift;
        if ( my $link = $data->{ $key } ) {
            $link->[_VAL] = shift;
        }
        else {
            $root->[_PREV] = $root->[_PREV][_NEXT] = $data->{ $key } = [
                "$key", shift(), $root->[_PREV], $root
            ];
        }
    }

    scalar( CORE::keys %{ $data } );
}

# sort ( "BY key [ ASC | DESC ] [ ALPHA ]" )
# sort ( "BY val [ ASC | DESC ] [ ALPHA ]" )
# sort ( "[ ASC | DESC ] [ ALPHA ]" ) # same as "BY val ..."

sub sort {
    my ( $self, $request ) = @_;
    my ( $by_key, $alpha, $desc ) = ( 0, 0, 0 );

    if ( length $request ) {
        $by_key = 1 if ( $request =~ /\bkey\b/i );
        $alpha  = 1 if ( $request =~ /\balpha\b/i );
        $desc   = 1 if ( $request =~ /\bdesc\b/i );
    }

    # Return sorted keys, leaving the data intact.

    if ( defined wantarray ) {
        if ( $by_key ) {                              # by key
            if ( $alpha ) { ( $desc )
              ? CORE::sort { $b cmp $a } $self->keys
              : CORE::sort { $a cmp $b } $self->keys;
            }
            else { ( $desc )
              ? CORE::sort { $b <=> $a } $self->keys
              : CORE::sort { $a <=> $b } $self->keys;
            }
        }
        else {                                        # by value
            my $d = $self->[_DATA];
            if ( $alpha ) { ( $desc )
              ? CORE::sort { $d->{$b}[_VAL] cmp $d->{$a}[_VAL] } $self->keys
              : CORE::sort { $d->{$a}[_VAL] cmp $d->{$b}[_VAL] } $self->keys;
            }
            else { ( $desc )
              ? CORE::sort { $d->{$b}[_VAL] <=> $d->{$a}[_VAL] } $self->keys
              : CORE::sort { $d->{$a}[_VAL] <=> $d->{$b}[_VAL] } $self->keys;
            }
        }
    }

    # Sort keys in-place otherwise, in void context.

    elsif ( $by_key ) {                               # by key
        if ( $alpha ) { ( $desc )
          ? $self->_reorder( CORE::sort { $b cmp $a } $self->keys )
          : $self->_reorder( CORE::sort { $a cmp $b } $self->keys );
        }
        else { ( $desc )
          ? $self->_reorder( CORE::sort { $b <=> $a } $self->keys )
          : $self->_reorder( CORE::sort { $a <=> $b } $self->keys );
        }
    }
    else {                                            # by value
        my $d = $self->[_DATA];
        if ( $alpha ) { ( $desc )
          ? $self->_reorder(
              CORE::sort { $d->{$b}[_VAL] cmp $d->{$a}[_VAL] } $self->keys
            )
          : $self->_reorder(
              CORE::sort { $d->{$a}[_VAL] cmp $d->{$b}[_VAL] } $self->keys
            );
        }
        else { ( $desc )
          ? $self->_reorder(
              CORE::sort { $d->{$b}[_VAL] <=> $d->{$a}[_VAL] } $self->keys
            )
          : $self->_reorder(
              CORE::sort { $d->{$a}[_VAL] <=> $d->{$b}[_VAL] } $self->keys
            );
        }
    }
}

sub _reorder {
    my $self = shift;
    my ( $data, $root ) = @{ $self };
    my ( $link );

    return unless @_;

    $root->[_PREV] = $root->[_NEXT] = $root;

    for ( @_ ) {
        if ( $link = $data->{$_} ) {
            $link->[_PREV] = $root->[_PREV];
            $link->[_NEXT] = $root;

            $root->[_PREV] = $root->[_PREV][_NEXT] = $link;
        }
    }

    return $self;
}

###############################################################################
## ----------------------------------------------------------------------------
## Sugar API, mostly resembles http://redis.io/commands#string primitives.
##
###############################################################################

# append ( key, string )

sub append {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, '') unless ( exists $data->{ $key } );

    if ( defined $_[2] ) {
       length( $data->{ $key }[_VAL] .= $_[2] );
    } else {
       length( $data->{ $key }[_VAL] .= '' );
    }
}

# decr ( key )

sub decr {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, 0) unless ( exists $data->{ $key } );

    --$data->{ $key }[_VAL];
}

# decrby ( key, number )

sub decrby {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, 0) unless ( exists $data->{ $key } );

    $data->{ $key }[_VAL] -= $_[2] || 0;
}

# incr ( key )

sub incr {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, 0) unless ( exists $data->{ $key } );

    ++$data->{ $key }[_VAL];
}

# incrby ( key, number )

sub incrby {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, 0) unless ( exists $data->{ $key } );

    $data->{ $key }[_VAL] += $_[2] || 0;
}

# getdecr ( key )

sub getdecr {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, 0) unless ( exists $data->{ $key } );

    $data->{ $key }[_VAL]-- || 0;
}

# getincr ( key )

sub getincr {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, 0) unless ( exists $data->{ $key } );

    $data->{ $key }[_VAL]++ || 0;
}

# getset ( key, value )

sub getset {
    my ( $key, $data ) = ( $_[1] , @{ $_[0] } );
    $_[0]->set($key, undef) unless ( exists $data->{ $key } );

    my $old = $data->{ $key }[_VAL];
    $data->{ $key }[_VAL] = $_[2];

    $old;
}

# len ( key )
# len ( )

sub len {
    if ( defined $_[1] ) {
        ( exists $_[0]->[_DATA]{ $_[1] } )
          ? length $_[0]->[_DATA]{ $_[1] }[_VAL]
          : undef;
    }
    else {
        scalar( CORE::keys %{ $_[0]->[_DATA] } );
    }
}

{
   no strict 'refs';

   *{ __PACKAGE__.'::new'     } = \&TIEHASH;
   *{ __PACKAGE__.'::set'     } = \&STORE;
   *{ __PACKAGE__.'::get'     } = \&FETCH;
   *{ __PACKAGE__.'::delete'  } = \&DELETE;
   *{ __PACKAGE__.'::exists'  } = \&EXISTS;
   *{ __PACKAGE__.'::clear'   } = \&CLEAR;
   *{ __PACKAGE__.'::pop'     } = \&POP;
   *{ __PACKAGE__.'::push'    } = \&PUSH;
   *{ __PACKAGE__.'::shift'   } = \&SHIFT;
   *{ __PACKAGE__.'::unshift' } = \&UNSHIFT;
   *{ __PACKAGE__.'::splice'  } = \&SPLICE;
   *{ __PACKAGE__.'::del'     } = \&delete;
   *{ __PACKAGE__.'::merge'   } = \&mset;
   *{ __PACKAGE__.'::vals'    } = \&values;
}

1;

__END__

###############################################################################
## ----------------------------------------------------------------------------
## Module usage.
##
###############################################################################

=head1 NAME

MCE::Shared::Indhash - An ordered hash class featuring doubly-linked list

=head1 SYNOPSIS

   # tie interface, non-shared
   tie my %oh, 'MCE::Shared::Indhash';

   # OO construction, non-shared
   use MCE::Shared::Indhash;

   my $oh = MCE::Shared::Indhash->new( @pairs );

   # OO construction, shared
   use MCE::Shared;
   use MCE::Shared::Indhash;

   my $oh = MCE::Shared->share( MCE::Shared::Indhash->new( @pairs ) );

   # OO API
   $val   = $oh->set( $key, $val );
   $val   = $oh->get( $key );
   $val   = $oh->delete( $key );              # del is an alias for delete
   $bool  = $oh->exists( $key );
   void   = $oh->clear();
   $len   = $oh->len();                       # scalar keys %{ $oh }
   $len   = $oh->len( $key );                 # length $oh->{ $key }
   @pair  = $oh->pop();
   $len   = $oh->push( @pairs );
   @pair  = $oh->shift();
   $len   = $oh->unshift( @pairs );
   %pairs = $oh->splice( $offset, $length, @pairs );

   $oh2   = $oh->clone( @keys );              # @keys is optional
   $oh3   = $oh->flush( @keys );
   $iter  = $oh->iterator( @keys );           # ($key, $val) = $iter->()
   @keys  = $oh->keys( @keys );
   %pairs = $oh->pairs( @keys );
   @vals  = $oh->values( @keys );             # vals is an alias for values

   $cnt   = $oh->mdel( @keys );
   @vals  = $oh->mget( @keys );
   $bool  = $oh->mexists( @keys );            # true if all keys exists
   $len   = $oh->mset( $key/$val pairs );     # merge is an alias for mset

   @vals  = $oh->sort();                      # by val $a <=> $b default
   @vals  = $oh->sort( "desc" );              # by val $b <=> $a
   @vals  = $oh->sort( "alpha" );             # by val $a cmp $b
   @vals  = $oh->sort( "alpha desc" );        # by val $b cmp $a

   @vals  = $oh->sort( "key" );               # by key $a <=> $b
   @vals  = $oh->sort( "key desc" );          # by key $b <=> $a
   @vals  = $oh->sort( "key alpha" );         # by key $a cmp $b
   @vals  = $oh->sort( "key alpha desc" );    # by key $b cmp $a

   # sugar methods without having to call set/get explicitly

   $len   = $oh->append( $key, $string );     #   $val .= $string
   $val   = $oh->decr( $key );                # --$val
   $val   = $oh->decrby( $key, $number );     #   $val -= $number
   $val   = $oh->getdecr( $key );             #   $val--
   $val   = $oh->getincr( $key );             #   $val++
   $val   = $oh->incr( $key );                # ++$val
   $val   = $oh->incrby( $key, $number );     #   $val += $number
   $old   = $oh->getset( $key, $new );        #   $o = $v, $v = $n, $o

=head1 DESCRIPTION

This module implements an ordered hash featuring a doubly-linked list,
inspired by the L<Tie::Hash::Indexed> (XS) module. An ordered hash means
that the key insertion order is preserved.

The nature of maintaining a circular list means extra memory consumption
by Perl itself. Typically, this is not a problem for thousands of key-value
pairs. See L<MCE::Shared::Ordhash> if lesser memory consumption is desired.

Both this module and C<MCE::Shared::Ordhash> may be used interchangeably.
Only the underlying implementation differs between the two.

=head1 API DOCUMENTATION

=over 3

=item new ( key, value [, key, value, ... ] )

Constructs a new object, with an optional list of key-value pairs.

   # non-shared
   use MCE::Shared::Indhash;

   $oh = MCE::Shared::Indhash->new( @pairs );
   $oh = MCE::Shared::Indhash->new( );

   # shared
   use MCE::Shared;
   use MCE::Shared::Indhash;

   $oh = MCE::Shared->share( MCE::Shared::Indhash->new( @pairs ) );
   $oh = MCE::Shared->share( MCE::Shared::Indhash->new( ) );

=item clear

Removes all key-value pairs from the hash.

   $oh->clear;

=item clone ( key [, key, ... ] )

Creates a shallow copy, a C<MCE::Shared::Ordhash> object. It returns an exact
copy if no arguments are given. Otherwise, the object includes only the given
keys in the same order. Keys that do not exist in the hash will have the
C<undef> value.

   $oh2 = $oh->clone( "key1", "key2" );
   $oh2 = $oh->clone;

=item delete ( key )

Deletes and returns the value by given key or C<undef> if the key does not
exists in the hash.

   $val = $oh->delete( "some_key" );

=item del

C<del> is an alias for C<delete>.

=item exists ( key )

Determines if a key exists in the hash.

   if ( $oh->exists( "some_key" ) ) { ... }

=item flush ( key [, key, ... ] )

Same as C<clone>. Though, clears all existing items before returning.

=item get ( key )

Gets the value of a hash key or C<undef> if the key does not exists.

   $val = $oh->get( "some_key" );

=item iterator ( key [, key, ... ] )

Returns a code reference for iterating a list of key-value pairs stored in
the hash when no arguments are given. Otherwise, returns a code reference for
iterating the given keys in the same order. Keys that do not exist will have
the C<undef> value.

The list of keys to return is set when the closure is constructed. Later keys
added to the hash are not included. Subsequently, the C<undef> value is
returned for deleted keys.

   $iter = $oh->iterator;
   $iter = $oh->iterator( "key1", "key2" );

   while ( my ( $key, $val ) = $iter->() ) {
      ...
   }

=item keys ( key [, key, ...] )

Returns hash keys in the same insertion order when no arguments are given.
Otherwise, returns the given keys in the same order. Keys that do not exist
will have the C<undef> value. In scalar context, returns the size of the hash.

   @keys = $oh->keys;
   @keys = $oh->keys( "key1", "key2" );
   $len  = $oh->keys;

=item len ( key )

Returns the size of the hash when no arguments are given. For the given key,
returns the length of the value stored at key or the C<undef> value if the
key does not exists.

   $size = $oh->len;
   $len  = $oh->len( "key1" );
   $len  = length $oh->{ "key1" };

=item mdel ( key [, key, ... ] )

Deletes one or more keys in the hash and returns the number of keys deleted.
A given key which does not exist in the hash is not counted.

   $cnt = $oh->mdel( "key1", "key2" );

=item mexists ( key [, key, ... ] )

Returns a true value if all given keys exists in the hash. A false value is
returned otherwise.

   if ( $oh->mexists( "key1", "key2" ) ) { ... }

=item mget ( key [, key, ... ] )

Gets the values of all given keys. It returns C<undef> for keys which do not
exists in the hash.

   ( $val1, $val2 ) = $oh->mget( "key1", "key2" );

=item mset ( key, value [, key, value, ... ] )

Sets multiple key-value pairs in a hash and returns the number of keys stored
in the hash.

   $len = $oh->mset( "key1" => "val1", "key2" => "val2" );

=item merge

C<merge> is an alias for C<mset>.

=item pairs ( key [, key, ... ] )

Returns key-value pairs in the same insertion order when no arguments are given.
Otherwise, returns key-value pairs for the given keys in the same order. Keys
that do not exist will have the C<undef> value. In scalar context, returns the
size of the hash.

   @pairs = $oh->pairs;
   @pairs = $oh->pairs( "key1", "key2" );
   $len   = $oh->pairs;

=item pop

Removes and returns the last key-value pair or value in scalar context of the
ordered hash. If there are no keys in the hash, returns the undefined value.

   ( $key, $val ) = $oh->pop;

   $val = $oh->pop;

=item push ( key, value [, key, value, ... ] )

Appends one or multiple key-value pairs to the tail of the ordered hash and
returns the new length. Any keys already existing in the hash are re-inserted
with the new values.

   $len = $oh->push( "key1", "val1", "key2", "val2" );

=item set ( key, value )

Sets the value of the given hash key and returns its new value.

   $val = $oh->set( "key", "value" );

=item shift

Removes and returns the first key-value pair or value in scalar context of the
ordered hash. If there are no keys in the hash, returns the undefined value.

   ( $key, $val ) = $oh->shift;

   $val = $oh->shift;

=item sort ( "BY key [ ASC | DESC ] [ ALPHA ]" )

=item sort ( "BY val [ ASC | DESC ] [ ALPHA ]" )

Returns sorted keys in list context, leaving the elements intact. In void
context, sorts the hash in-place. By default, sorting is numeric and applied
to values when no arguments are given.

   @keys = $oh->sort( "BY val" );

   $oh->sort();

If the keys or values contain string values and you want to sort them
lexicographically, specify the C<ALPHA> modifier.

   @keys = $oh->sort( "BY key ALPHA" );

   $oh->sort( "BY val ALPHA" );

The default is C<ASC> for sorting the hash from small to large. In order to
sort the hash from large to small, specify the C<DESC> modifier.

   @keys = $oh->sort( "BY val DESC ALPHA" );

   $oh->sort( "BY key DESC ALPHA" );

=item splice ( offset [, length [, key, value, ... ] ] )

Removes the key-value pairs designated by C<offset> and C<length> from the
ordered hash, and replaces them with C<key-value pairs>, if any. The behavior
is similar to the Perl C<splice> function.

   @pairs = $oh->splice( 20, 2, @pairs );
   @pairs = $oh->splice( 20, 2 );
   @pairs = $oh->splice( 20 );

=item unshift ( key, value [, key, value, ... ] )

Prepends one or multiple key-value pairs to the head of the ordered hash and
returns the new length. Any keys already existing in the hash are re-inserted
with the new values.

   $len = $oh->unshift( "key1", "val1", "key2", "val2" );

=item values ( key [, key, ... ] )

Returns hash values in the same insertion order when no arguments are given.
Otherwise, returns values for the given keys in the same order. Keys that do
not exist will have the C<undef> value. In scalar context, returns the size
of the hash.

   @vals = $oh->values;
   @vals = $oh->values( "key1", "key2" );
   $len  = $oh->values;

=item vals

C<vals> is an alias for C<values>.

=back

=head1 SUGAR METHODS

This module is equipped with sugar methods to not have to call C<set>
and C<get> explicitly. The API resembles a subset of the Redis primitives
L<http://redis.io/commands#strings> with key representing the hash key.

=over 3

=item append ( key, string )

Appends a value to a key and returns its new length.

   $len = $oh->append( $key, "foo" );

=item decr ( key )

Decrements the value of a key by one and returns its new value.

   $num = $oh->decr( $key );

=item decrby ( key, number )

Decrements the value of a key by the given number and returns its new value.

   $num = $oh->decrby( $key, 2 );

=item getdecr ( key )

Decrements the value of a key by one and returns its old value.

   $old = $oh->getdecr( $key );

=item getincr ( key )

Increments the value of a key by one and returns its old value.

   $old = $oh->getincr( $key );

=item getset ( key, value )

Sets the value of a key and returns its old value.

   $old = $oh->getset( $key, "baz" );

=item incr ( key )

Increments the value of a key by one and returns its new value.

   $num = $oh->incr( $key );

=item incrby ( key, number )

Increments the value of a key by the given number and returns its new value.

   $num = $oh->incrby( $key, 2 );

=back

=head1 CREDITS

This doubly-linked list implementation is inspired by L<Tie::Hash::Indexed>.

=head1 AUTHOR

Mario E. Roy, S<E<lt>marioeroy AT gmail DOT comE<gt>>

=cut

test1.pl

use strict;
use warnings;

use MCE::Shared Sereal => 1;
use Tie::Hash::Indexed;

my @pairs = (1..50000);

my $thi = MCE::Shared->share({ module => 'Tie::Hash::Indexed' }, @pairs);
my $oh2 = $thi->export();

print scalar($thi->keys), "\n";
print scalar($oh2->keys), "\n";

test2.pl

 use strict;
 use warnings;

 use MCE::Hobo;
 use MCE::Shared::Indhash;
 use MCE::Shared::Ordhash;

 use Storable;
 my $_freeze = \&Storable::freeze;
 my $_thaw   = \&Storable::thaw;

#use Sereal::Encoder qw( encode_sereal );
#use Sereal::Decoder qw( decode_sereal );
#my $_freeze = sub { encode_sereal(@_, { freeze_callbacks => 1 }) };
#my $_thaw   = \&decode_sereal;

#my $oh = MCE::Shared::Indhash->new();
 my $oh = MCE::Shared::Ordhash->new();

 my $thr = MCE::Hobo->create( sub {
     $oh->set($_,$_) for 1 .. 40000;
     my $fro = $_freeze->($oh);
     my $oh  = $_thaw->($fro);
     my $cnt = $oh->keys;
     print "$cnt\n";
     $fro;
 });

 my $fro = $thr->join;
 my $oh2 = $_thaw->($fro);
 my $cnt = $oh2->keys;
 print "$cnt\n";

__END__
MCE::Shared::Indhash (pass)
40000
40000

MCE::Shared::Ordhash (pass)
40000
40000