File Coverage

blib/lib/MCE/Shared/Cache.pm

Criterion	Covered	Total	%
statement	224	478	46.8
branch	61	216	28.2
condition	24	92	26.0
subroutine	29	59	49.1
pod	27	27	100.0
total	365	872	41.8

###############################################################################
## ----------------------------------------------------------------------------
## A hybrid LRU-plain cache helper class.
##
## An optimized, pure-Perl LRU implementation with extra performance when
## fetching items from the upper-section of the cache.
##
###############################################################################

package MCE::Shared::Cache;

use strict;
use warnings;

use 5.010001;

no warnings qw( threads recursion uninitialized numeric );

our $VERSION = '1.886';

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

use Scalar::Util qw( dualvar looks_like_number );
use Time::HiRes qw( time );

use MCE::Shared::Base ();
use base 'MCE::Shared::Common';

use constant {
   _DATA => 0,  # unordered data
   _KEYS => 1,  # LRU queue
   _INDX => 2,  # index into _KEYS
   _BEGI => 3,  # begin offset value
   _GCNT => 4,  # garbage count
   _EXPI => 5,  # max age, default disabled
   _SIZE => 6,  # max keys, default disabled
   _HREF => 7,  # for hash-like dereferencing
   _ITER => 8,  # for tied hash support
};

use overload (
   q("")    => \&MCE::Shared::Base::_stringify,
   q(0+)    => \&MCE::Shared::Base::_numify,
   q(%{})   => sub {
      no overloading;
      $_[0]->[_HREF] || do {
         # no circular reference to original, therefore no memory leaks
         tie my %h, __PACKAGE__.'::_href', bless([ @{ $_[0] } ], __PACKAGE__);
         $_[0]->[_HREF] = \%h;
      };
   },
   fallback => 1
);

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

# TIEHASH ( max_keys => undef, max_age => undef );  # default
# TIEHASH ( { options }, @pairs );
# TIEHASH ( )

sub TIEHASH {
   my $class = shift;
   my $opts  = ( ref $_[0] eq 'HASH' ) ? shift : undef;

   if ( !defined $opts ) {
      $opts = {};
      for my $cnt ( 1 .. 2 ) {
         if ( @_ && $_[0] =~ /^(max_keys|max_age)$/ ) {
            $opts->{ $1 } = $_[1];
            splice @_, 0, 2;
         }
      }
   }

   my ( $begi, $gcnt ) = ( 0, 0 );
   my $expi = MCE::Shared::Cache::_secs( $opts->{'max_age' } // undef );
   my $size = MCE::Shared::Cache::_size( $opts->{'max_keys'} // undef );

   my $obj = bless [ {}, [], {}, \$begi, \$gcnt, \$expi, \$size ], $class;

   $obj->mset(@_) if @_;
   $obj;
}

# STORE ( key, value [, expires_in ] )

sub STORE {
   my ( $data, $keys, $indx, $begi, $gcnt, $expi, $size ) = @{ $_[0] };
   my $exptime = ( @_ == 4 ) ? $_[3] : ${ $expi };

   if ( !defined $exptime ) {
      $exptime = -1;
   } elsif ( !looks_like_number $exptime ) {
      $exptime = MCE::Shared::Cache::_secs( $exptime );
   }

   # update existing key
   if ( defined ( my $off = $indx->{ $_[1] } ) ) {
      $off -= ${ $begi };

      # update expiration
      $keys->[ $off ] = ( $exptime >= 0 )
         ? dualvar( time + $exptime, $_[1] )
         : dualvar( -1, $_[1] );

      # promote key if not last, inlined for performance
      if ( ! $off ) {
         return $data->{ $_[1] } = $_[2] if @{ $keys } == 1;

         push @{ $keys }, shift @{ $keys };
         $indx->{ $_[1] } = ++${ $begi } + @{ $keys } - 1;

         MCE::Shared::Cache::_gckeys_head( $keys, $begi, $gcnt )
            if ( ${ $gcnt } && !defined $keys->[ 0 ] );

         # safety to not overrun
         $_[0]->purge if ( ${ $begi } > 1e9 );
      }
      elsif ( $off != @{ $keys } - 1 ) {
         push @{ $keys }, delete $keys->[ $off ];
         $indx->{ $_[1] } = ${ $begi } + @{ $keys } - 1;

         # GC keys if the gcnt:size ratio is greater than 2:3
         $_[0]->purge if ( ++${ $gcnt } > @{ $keys } * 0.667 );
      }

      return $data->{ $_[1] } = $_[2];
   }

   # insert key-value pair
   $data->{ $_[1] } = $_[2];
   $indx->{ $_[1] } = ${ $begi } + @{ $keys };

   push @{ $keys }, ( $exptime >= 0 )
      ? dualvar( time + $exptime, $_[1] )
      : dualvar( -1, $_[1] );

   # evict the least used key, inlined for performance
   if ( defined ${ $size } && @{ $keys } - ${ $gcnt } > ${ $size } ) {
      my $key = shift @{ $keys };
      ${ $begi }++, delete($data->{ $key }), delete($indx->{ $key });

      MCE::Shared::Cache::_gckeys_head( $keys, $begi, $gcnt )
         if ( ${ $gcnt } && !defined $keys->[ 0 ] );

      # safety to not overrun
      $_[0]->purge if ( ${ $begi } > 1e9 );
   }

   $_[2];
}

# FETCH ( key )

sub FETCH {

   # cache miss
   return undef if !defined ( my $off = $_[0]->[_INDX]{ $_[1] } );

   # cache hit
   my ( $data, $keys, $indx, $begi, $gcnt ) = @{ $_[0] };

   $off -= ${ $begi };

   # key expired
   $_[0]->del( $_[1] ), return undef if (
      $keys->[ $off ] >= 0 && $keys->[ $off ] < time
   );

   # promote key if not upper half, inlined for performance
   if ( ! $off ) {
      return $data->{ $_[1] } if @{ $keys } == 1;

      push @{ $keys }, shift @{ $keys };
      $indx->{ $_[1] } = ++${ $begi } + @{ $keys } - 1;

      MCE::Shared::Cache::_gckeys_head( $keys, $begi, $gcnt )
         if ( ${ $gcnt } && !defined $keys->[ 0 ] );

      # safety to not overrun
      $_[0]->purge if ( ${ $begi } > 1e9 );
   }
   elsif ( $off - ${ $gcnt } < ( ( @{ $keys } - ${ $gcnt } ) >> 1 ) ) {
      push @{ $keys }, delete $keys->[ $off ];
      $indx->{ $_[1] } = ${ $begi } + @{ $keys } - 1;

      # GC keys if the gcnt:size ratio is greater than 2:3
      $_[0]->purge if ( ++${ $gcnt } > @{ $keys } * 0.667 );
   }

   $data->{ $_[1] };
}

# DELETE ( key )

sub DELETE {
   my ( $data, $keys, $indx, $begi, $gcnt ) = @{ $_[0] };

   return undef if !defined ( my $off = delete $indx->{ $_[1] } );

   $off -= ${ $begi };

   # check the first key
   if ( ! $off ) {
      ${ $begi }++; shift @{ $keys };

      if ( ${ $gcnt } && !defined $keys->[ 0 ] ) {
         MCE::Shared::Cache::_gckeys_head( $keys, $begi, $gcnt );
      } elsif ( ! @{ $keys } ) {
         ${ $begi } = 0;
      }

      return delete $data->{ $_[1] };
   }

   # check the last key
   elsif ( $off == @{ $keys } - 1 ) {
      pop @{ $keys };

      if ( ${ $gcnt } && !defined $keys->[ -1 ] ) {
         MCE::Shared::Cache::_gckeys_tail( $keys, $gcnt );
      } elsif ( ! @{ $keys } ) {
         ${ $begi } = 0;
      }

      return delete $data->{ $_[1] };
   }

   # must be a key somewhere in-between
   $keys->[ $off ] = undef;   # tombstone

   # GC keys if the gcnt:size ratio is greater than 2:3
   $_[0]->purge if ( ++${ $gcnt } > @{ $keys } * 0.667 );

   delete $data->{ $_[1] };
}

# FIRSTKEY ( )

sub FIRSTKEY {
   my $self = shift;
   $self->[_ITER] = [ $self->keys ];

   $self->NEXTKEY;
}

# NEXTKEY ( )

sub NEXTKEY {
   shift @{ $_[0]->[_ITER] };
}

# EXISTS ( key )

sub EXISTS {
   my ( $self, $key ) = @_;
   return '' if !defined ( my $off = $self->[_INDX]{ $key } );

   $off -= ${ $self->[_BEGI] };

   $self->del( $key ), return '' if (
      $self->[_KEYS][ $off ] >= 0 &&
      $self->[_KEYS][ $off ] < time
   );

   1;
}

# CLEAR ( )

sub CLEAR {
   my ( $data, $keys, $indx, $begi, $gcnt ) = @{ $_[0] };

   %{ $data } = @{ $keys } = %{ $indx } = ();
   ${ $begi } = ${ $gcnt } = 0;

   delete $_[0]->[_ITER];

   return;
}

# SCALAR ( )

sub SCALAR {
   $_[0]->_prune_head;

   scalar keys %{ $_[0]->[_DATA] };
}

###############################################################################
## ----------------------------------------------------------------------------
## Internal routines for preserving dualvar KEYS data during freeze-thaw ops.
##
###############################################################################

## Storable freeze-thaw

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

   my @TIME; $self->purge;

   for my $key ( @{ $self->[_KEYS] } ) {
      push @TIME, 0 + $key;
   }

   return '', [ @{ $self }, \@TIME ];
}

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

   my $TIME = pop @{ $ret };
   @{ $self } = @{ $ret };

   my ( $i, $keys ) = ( 0, $self->[_KEYS] );

   for my $time ( @{ $TIME } ) {
      $keys->[ $i ] = dualvar( $time, $keys->[ $i ] );
      $i++;
   }

   return;
}

## Sereal freeze-thaw

sub FREEZE {
   my ( $self ) = @_;
   my @TIME; $self->purge;

   for my $key ( @{ $self->[_KEYS] } ) {
      push @TIME, 0 + $key;
   }

   return [ @{ $self }, \@TIME ];
}

sub THAW {
   my ( $class, $serializer, $data ) = @_;
   my $TIME = pop @{ $data };
   my $self = $class->new;

   @{ $self } = @{ $data };

   my ( $i, $keys ) = ( 0, $self->[_KEYS] );

   for my $time ( @{ $TIME } ) {
      $keys->[ $i ] = dualvar( $time, $keys->[ $i ] );
      $i++;
   }

   return $self;
}

###############################################################################
## ----------------------------------------------------------------------------
## _gckeys_head, _gckeys_tail, _inskey, _prune_head, _secs, _size
##
###############################################################################

# GC start of list

sub _gckeys_head {
   my ( $keys, $begi, $gcnt ) = @_;
   my $i = 1;

   $i++ until ( defined $keys->[ $i ] );
   ${ $begi } += $i, ${ $gcnt } -= $i;
   splice @{ $keys }, 0, $i;

   return;
}

# GC end of list

sub _gckeys_tail {
   my ( $keys, $gcnt ) = @_;
   my $i = $#{ $keys } - 1;

   $i-- until ( defined $keys->[ $i ] );
   ${ $gcnt } -= $#{ $keys } - $i;
   splice @{ $keys }, $i + 1;

   return;
}

# insert or promote key

sub _inskey {
   my ( $data, $keys, $indx, $begi, $gcnt, $expi, $size ) = @{ $_[0] };
   my $exptime = ( @_ == 3 ) ? $_[2] : ${ $expi };

   if ( !defined $exptime ) {
      $exptime = -1;
   } elsif ( !looks_like_number $exptime ) {
      $exptime = MCE::Shared::Cache::_secs( $exptime );
   }

   # update existing key
   if ( defined ( my $off = $indx->{ $_[1] } ) ) {
      $off -= ${ $begi };

      # unset value if expired
      $data->{ $_[1] } = undef
         if ( $keys->[ $off ] >= 0 && $keys->[ $off ] < time );

      # update expiration
      $keys->[ $off ] = ( $exptime >= 0 )
         ? dualvar( time + $exptime, $_[1] )
         : dualvar( -1, $_[1] );

      # promote key if not last, inlined for performance
      if ( ! $off ) {
         return if @{ $keys } == 1;

         push @{ $keys }, shift @{ $keys };
         $indx->{ $_[1] } = ++${ $begi } + @{ $keys } - 1;

         MCE::Shared::Cache::_gckeys_head( $keys, $begi, $gcnt )
            if ( ${ $gcnt } && !defined $keys->[ 0 ] );

         # safety to not overrun
         $_[0]->purge if ( ${ $begi } > 1e9 );
      }
      elsif ( $off != @{ $keys } - 1 ) {
         push @{ $keys }, delete $keys->[ $off ];
         $indx->{ $_[1] } = ${ $begi } + @{ $keys } - 1;

         # GC keys if the gcnt:size ratio is greater than 2:3
         $_[0]->purge if ( ++${ $gcnt } > @{ $keys } * 0.667 );
      }

      return;
   }

   # insert key
   $indx->{ $_[1] } = ${ $begi } + @{ $keys };

   push @{ $keys }, ( $exptime >= 0 )
      ? dualvar( time + $exptime, $_[1] )
      : dualvar( -1, $_[1] );

   # evict the least used key, inlined for performance
   if ( defined ${ $size } && @{ $keys } - ${ $gcnt } > ${ $size } ) {
      my $key = shift @{ $keys };
      ${ $begi }++, delete($data->{ $key }), delete($indx->{ $key });

      MCE::Shared::Cache::_gckeys_head( $keys, $begi, $gcnt )
         if ( ${ $gcnt } && !defined $keys->[ 0 ] );

      # safety to not overrun
      $_[0]->purge if ( ${ $begi } > 1e9 );
   }

   return;
}

# prune start of list

sub _prune_head {
   my ( $data, $keys, $indx, $begi, $gcnt ) = @{ $_[0] };
   my ( $i, $time ) = ( 0, time );

   for my $k ( @{ $keys } ) {
      $i++, ${ $gcnt }--, next unless ( defined $k );
      last if ( $keys->[ $i ] < 0 || $keys->[ $i ] > $time );

      delete $data->{ $k };
      delete $indx->{ $k };

      $i++;
   }

   ${ $begi } += $i, splice @{ $keys }, 0, $i if $i;

   return;
}

# compute seconds

{
   # seconds, minutes, hours, days, weeks
   my %secs = ( '' => 1, s => 1, m => 60, h => 3600, d => 86400, w => 604800 );

   sub _secs {
      my ( $secs ) = @_;

      return undef if ( !defined $secs || $secs eq 'never' );
      return 0 if ( !$secs || $secs eq 'now' );
      return 0.0001 if ( $secs < 0.0001 );

      $secs = $1 * $secs{ lc($2) }
         if ( $secs =~ /^(\d*\.?\d*)\s*([smhdw]?)/i );

      $secs;
   }
}

# compute size

{
   # kibiBytes (KiB), mebiBytes (MiB)
   my %size = ( '' => 1, k => 1024, m => 1048576 );

   # Digital Information Sizes Calculator
   # https://dr-lex.be/info-stuff/bytecalc.html

   sub _size {
      my ( $size ) = @_;

      return undef if ( !defined $size || $size eq 'unlimited' );
      return 0 if ( !$size || $size < 0 );

      $size = $1 * $size{ lc($2) }
         if ( $size =~ /^(\d*\.?\d*)\s*([km]?)/i );

      $size = int( $size + 0.5 );
   }
}

###############################################################################
## ----------------------------------------------------------------------------
## _find, iterator, keys, pairs, values
##
###############################################################################

# _find ( { getkeys => 1 }, "query string" )
# _find ( { getvals => 1 }, "query string" )
# _find ( "query string" ) # pairs

sub _find {
   my $self   = shift;
   my $params = ref($_[0]) eq 'HASH' ? shift : {};
   my $query  = shift;

   MCE::Shared::Base::_find_hash( $self->[_DATA], $params, $query, $self );
}

# iterator ( key [, key, ... ] )
# iterator ( "query string" )
# iterator ( )

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

   if ( ! @keys ) {
      @keys = $self->keys;
   }
   elsif ( @keys == 1 && $keys[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      @keys = $self->keys($keys[0]);
   }
   else {
      $self->_prune_head;
   }

   return sub {
      return unless @keys;
      my $key = shift @keys;
      return ( $key => $data->{ $key } );
   };
}

# keys ( key [, key, ... ] )
# keys ( "query string" )
# keys ( )

sub keys {
   my $self = shift;
   $self->_prune_head;

   if ( @_ == 1 && $_[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      $self->_find( { getkeys => 1 }, @_ );
   }
   elsif ( wantarray ) {
      my $data = $self->[_DATA];
      @_ ? map { exists $data->{ $_ } ? $_ : undef } @_
         : $self->_keys;
   }
   else {
      scalar CORE::keys %{ $self->[_DATA] };
   }
}

# _keys ( )

sub _keys {
   my $self = shift;

   map { ''. $_ } ${ $self->[_GCNT] }
      ? grep defined($_), reverse @{ $self->[_KEYS] }
      : reverse @{ $self->[_KEYS] };
}

# pairs ( key [, key, ... ] )
# pairs ( "query string" )
# pairs ( )

sub pairs {
   my $self = shift;
   $self->_prune_head;

   if ( @_ == 1 && $_[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      $self->_find( @_ );
   }
   elsif ( wantarray ) {
      my $data = $self->[_DATA];
      map { $_ => $data->{ $_ } } ( @_ ? @_ : $self->_keys );
   }
   else {
      scalar CORE::keys %{ $self->[_DATA] };
   }
}

# values ( key [, key, ... ] )
# values ( "query string" )
# values ( )

sub values {
   my $self = shift;
   $self->_prune_head;

   if ( @_ == 1 && $_[0] =~ /^(?:key|val)[ ]+\S\S?[ ]+\S/ ) {
      $self->_find( { getvals => 1 }, @_ );
   }
   elsif ( wantarray ) {
      @{ $self->[_DATA] }{ ( @_ ? @_ : $self->_keys ) };
   }
   else {
      scalar CORE::keys %{ $self->[_DATA] };
   }
}

###############################################################################
## ----------------------------------------------------------------------------
## assign, max_age, max_keys, mdel, mexists, mget, mset, peek, purge
##
###############################################################################

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

sub assign {
   $_[0]->clear; shift()->mset(@_);
}

# max_age ( [ secs ] )

sub max_age {
   my ( $self, $secs ) = @_;
   my $expi = $self->[_EXPI];

   if ( @_ == 2 && defined $secs ) {
      ${ $expi } = MCE::Shared::Cache::_secs( $secs );
   }
   elsif ( @_ == 2 ) {
      ${ $expi } = undef;
   }

   if ( defined wantarray ) {
      defined ${ $expi } ? ${ $expi } > 0 ? ${ $expi } : 'now' : 'never';
   }
}

# max_keys ( [ size ] )

sub max_keys {
   my ( $self, $size ) = @_;

   if ( @_ == 2 && defined $size ) {
      $size = MCE::Shared::Cache::_size( $size );
      $self->purge;

      my ( $data, $keys, $indx, $begi ) = @{ $self };
      my $count = CORE::keys( %{ $data } ) - $size;

      # evict the least used keys
      while ( $count-- > 0 ) {
         my $key = shift @{ $keys };
         ${ $begi }++, delete($data->{ $key }), delete($indx->{ $key });

         # safety to not overrun
         $self->purge if ( ${ $begi } > 1e9 );
      }

      ${ $self->[_SIZE] } = $size;
   }
   elsif ( @_ == 2 ) {
      ${ $self->[_SIZE] } = undef;
   }

   if ( defined wantarray ) {
      defined ${ $self->[_SIZE] } ? ${ $self->[_SIZE] } : 'unlimited';
   }
}

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

sub mdel {
   my $self = shift;
   my $cnt  = 0;

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

   $cnt;
}

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

sub mexists {
   my $self = shift;

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

   1;
}

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

sub mget {
   my $self = shift;

   @_ ? map { $self->get( $_ ) } @_ : ();
}

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

sub mset {
   my $self = shift;

   while ( @_ ) {
      $self->set( splice( @_, 0, 2 ) );
   }

   defined wantarray ? $self->SCALAR : ();
}

# peek ( key )

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

# purge ( )

sub purge {
   my ( $data, $keys, $indx, $begi, $gcnt ) = @{ $_[0] };
   my $i;  $i = ${ $begi } = ${ $gcnt } = 0;

   # purge in-place for minimum memory consumption

   my $time = time;

   for my $k ( @{ $keys } ) {
      delete($data->{ $k }), delete($indx->{ $k }), next
         if ( defined $k && $k >= 0 && $k < $time );

      $keys->[ $i ] = $k, $indx->{ $k } = $i++
         if ( defined $k );
   }

   splice @{ $keys }, $i;

   return;
}

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

# append ( key, string [, expires_in ] )

sub append {
   $_[0]->_inskey( $_[1], defined $_[3] ? $_[3] : () );
   length( $_[0]->[_DATA]{ $_[1] } .= $_[2] // '' );
}

# decr ( key [, expires_in ] )

sub decr {
   $_[0]->_inskey( $_[1], defined $_[2] ? $_[2] : () );
   --$_[0]->[_DATA]{ $_[1] };
}

# decrby ( key, number [, expires_in ] )

sub decrby {
   $_[0]->_inskey( $_[1], defined $_[3] ? $_[3] : () );
   $_[0]->[_DATA]{ $_[1] } -= $_[2] || 0;
}

# incr ( key [, expires_in ] )

sub incr {
   $_[0]->_inskey( $_[1], defined $_[2] ? $_[2] : () );
   ++$_[0]->[_DATA]{ $_[1] };
}

# incrby ( key, number [, expires_in ] )

sub incrby {
   $_[0]->_inskey( $_[1], defined $_[3] ? $_[3] : () );
   $_[0]->[_DATA]{ $_[1] } += $_[2] || 0;
}

# getdecr ( key [, expires_in ] )

sub getdecr {
   $_[0]->_inskey( $_[1], defined $_[2] ? $_[2] : () );
   $_[0]->[_DATA]{ $_[1] }-- // 0;
}

# getincr ( key [, expires_in ] )

sub getincr {
   $_[0]->_inskey( $_[1], defined $_[2] ? $_[2] : () );
   $_[0]->[_DATA]{ $_[1] }++ // 0;
}

# getset ( key, value [, expires_in ] )

sub getset {
   $_[0]->_inskey( $_[1], defined $_[3] ? $_[3] : () );

   my $old = $_[0]->[_DATA]{ $_[1] };
   $_[0]->[_DATA]{ $_[1] } = $_[2];

   $old;
}

# setnx ( key, value [, expires_in ] )

sub setnx {
   return 0 if ( exists $_[0]->[_DATA]{ $_[1] } );

   $_[0]->_inskey( $_[1], defined $_[3] ? $_[3] : () );
   $_[0]->[_DATA]{ $_[1] } = $_[2];

   1;
}

# len ( key )
# len ( )

sub len {
   $_[0]->_prune_head;

   ( defined $_[1] )
      ? length $_[0]->get( $_[1] )
      : 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__.'::del'    } = \&delete;
   *{ __PACKAGE__.'::remove' } = \&delete;
   *{ __PACKAGE__.'::merge'  } = \&mset;
   *{ __PACKAGE__.'::vals'   } = \&values;
}

# For on-demand hash-like dereferencing.

package # hide from rpm
   MCE::Shared::Cache::_href;

sub TIEHASH { $_[1] }

1;

__END__