/ 
MCE-Shared-1.879
River stage one • 2 direct dependents • 3 total dependents
/ MCE::Shared::Cache

NAME

MCE::Shared::Cache - A hybrid LRU-plain cache helper class

VERSION

This document describes MCE::Shared::Cache version 1.879

DESCRIPTION

A cache helper class for use as a standalone or managed by MCE::Shared.

This module implements a least-recently used (LRU) cache with its origin based on MCE::Shared::Ordhash, for its performance and low-memory characteristics. It is both a LRU and plain implementation. LRU logic is applied to new items and subsequent updates. A fetch however, involves LRU reorder only if the item is found in the lower section of the cache. This equates to extra performance for the upper section as fetch behaves similarly to accessing a plain cache. Upon reaching its size restriction, it prunes items from the bottom of the cache.

The 50% LRU-mode (bottom section), 50% plain-mode (upper-section) applies to fetches only.

SYNOPSIS

# non-shared or local construction for use by a single process

use MCE::Shared::Cache;

my $ca;

$ca = MCE::Shared::Cache->new(); # max_keys => undef, max_age => undef
$ca = MCE::Shared::Cache->new( { max_keys => 500 }, @pairs );

$ca = MCE::Shared::Cache->new( max_keys => "unlimited", max_age => "never" );
$ca = MCE::Shared::Cache->new( max_keys => undef, max_age => undef ); # ditto
$ca = MCE::Shared::Cache->new( max_keys => 500, max_age => "1 hour" );
$ca = MCE::Shared::Cache->new( max_keys => "4 KiB" ); # 4*1024
$ca = MCE::Shared::Cache->new( max_keys => "1 MiB" ); # 1*1024*1024

$ca = MCE::Shared::Cache->new( max_age  => "43200 seconds" );
$ca = MCE::Shared::Cache->new( max_age  => 43200 );   # ditto
$ca = MCE::Shared::Cache->new( max_age  => "720 minutes" );
$ca = MCE::Shared::Cache->new( max_age  => "12 hours" );
$ca = MCE::Shared::Cache->new( max_age  => "0.5 days" );
$ca = MCE::Shared::Cache->new( max_age  => "1 week" );
$ca = MCE::Shared::Cache->new( max_age  => undef );   # no expiration
$ca = MCE::Shared::Cache->new( max_age  => 0 );       # now

# construction for sharing with other threads and processes

use MCE::Shared;

my $ca;

$ca = MCE::Shared->cache(); # max_keys => undef, max_age => undef
$ca = MCE::Shared->cache( { max_keys => 500 }, @pairs );

$ca = MCE::Shared->cache( max_keys => "unlimited", max_age => "never" );
$ca = MCE::Shared->cache( max_keys => undef, max_age => undef ); # ditto
$ca = MCE::Shared->cache( max_keys => 500, max_age => "1 hour" );
$ca = MCE::Shared->cache( max_keys => "4 KiB" ); # 4*1024
$ca = MCE::Shared->cache( max_keys => "1 MiB" ); # 1*1024*1024

$ca = MCE::Shared->cache( max_age  => "43200 seconds" );
$ca = MCE::Shared->cache( max_age  => 43200 );   # ditto
$ca = MCE::Shared->cache( max_age  => "720 minutes" );
$ca = MCE::Shared->cache( max_age  => "12 hours" );
$ca = MCE::Shared->cache( max_age  => "0.5 days" );
$ca = MCE::Shared->cache( max_age  => "1 week" );
$ca = MCE::Shared->cache( max_age  => undef );   # no expiration
$ca = MCE::Shared->cache( max_age  => 0 );       # now

# hash-like dereferencing

my $val = $ca->{$key};
$ca->{$key} = $val;

%{$ca} = ();

# OO interface

if ( !defined ( $val = $ca->get("some_key") ) ) {
   $val = $ca->set( some_key => "some_value" );
}

$val   = $ca->set( $key, $val );
$ret   = $ca->setnx( $key, $val );         # set only if the key exists
$val   = $ca->get( $key );
$val   = $ca->delete( $key );              # del is an alias for delete
$bool  = $ca->exists( $key );
void   = $ca->clear();
$len   = $ca->len();                       # scalar keys %{ $ca }
$len   = $ca->len( $key );                 # length $ca->{ $key }

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

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

# included, sugar methods without having to call set/get explicitly

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

# pipeline, provides atomicity for shared objects, MCE::Shared v1.09+

@vals  = $ca->pipeline(                    # ( "a_a", "b_b", "c_c" )
   [ "set", foo => "a_a" ],
   [ "set", bar => "b_b" ],
   [ "set", baz => "c_c" ],
   [ "mget", qw/ foo bar baz / ]
);

For normal hash behavior, the TIE interface is supported.

# non-shared or local construction for use by a single process

use MCE::Shared::Cache;

tie my %ca, "MCE::Shared::Cache", max_keys => undef, max_age => undef;
tie my %ca, "MCE::Shared::Cache", max_keys => 500, max_age => "1 hour";
tie my %ca, "MCE::Shared::Cache", { max_keys => 500 }, @pairs;

# construction for sharing with other threads and processes
# one option is needed minimally to know to use MCE::Shared::Cache

use MCE::Shared;

tie my %ca, "MCE::Shared", max_keys => undef, max_age => undef;
tie my %ca, "MCE::Shared", max_keys => 500, max_age => "1 hour";
tie my %ca, "MCE::Shared", { max_keys => 500 }, @pairs;

# usage

my $val;

if ( !defined ( $val = $ca{some_key} ) ) {
   $val = $ca{some_key} = "some_value";
}

$ca{some_key} = 0;

tied(%ca)->incrby("some_key", 20);
tied(%ca)->incrby(some_key => 20);

SYNTAX for QUERY STRING

Several methods take a query string for an argument. The format of the string is described below. In the context of sharing, the query mechanism is beneficial for the shared-manager process. It is able to perform the query where the data resides versus the client-process grep locally involving lots of IPC.

o Basic demonstration

  @keys = $ca->keys( "query string given here" );
  @keys = $ca->keys( "val =~ /pattern/" );

o Supported operators: =~ !~ eq ne lt le gt ge == != < <= > >=
o Multiple expressions delimited by :AND or :OR, mixed case allowed

  "key eq 'some key' :or (val > 5 :and val < 9)"
  "key eq some key :or (val > 5 :and val < 9)"
  "key =~ /pattern/i :And val =~ /pattern/i"
  "val eq foo baz :OR key !~ /pattern/i"

  * key matches on keys in the cache
  * likewise, val matches on values

o Quoting is optional inside the string

  "key =~ /pattern/i :AND val eq 'foo bar'"   # val eq "foo bar"
  "key =~ /pattern/i :AND val eq foo bar"     # val eq "foo bar"

Examples.

# search capability key/val: =~ !~ eq ne lt le gt ge == != < <= > >=
# key/val means to match against actual key/val respectively

@keys  = $ca->keys( "key eq 'some key' :or (val > 5 :and val < 9)" );
@keys  = $ca->keys( "key eq some key :or (val > 5 :and val < 9)" );

@keys  = $ca->keys( "key =~ /$pattern/i" );
@keys  = $ca->keys( "key !~ /$pattern/i" );
@keys  = $ca->keys( "val =~ /$pattern/i" );
@keys  = $ca->keys( "val !~ /$pattern/i" );

%pairs = $ca->pairs( "key == $number" );
%pairs = $ca->pairs( "key != $number :and val > 100" );
%pairs = $ca->pairs( "key <  $number :or key > $number" );
%pairs = $ca->pairs( "val <= $number" );
%pairs = $ca->pairs( "val >  $number" );
%pairs = $ca->pairs( "val >= $number" );

@vals  = $ca->vals( "key eq $string" );
@vals  = $ca->vals( "key ne $string with space" );
@vals  = $ca->vals( "key lt $string :or val =~ /$pat1|$pat2/" );
@vals  = $ca->vals( "val le $string :and val eq 'foo bar'" );
@vals  = $ca->vals( "val le $string :and val eq foo bar" );
@vals  = $ca->vals( "val gt $string" );
@vals  = $ca->vals( "val ge $string" );

API DOCUMENTATION

This module involves TIE when accessing the object via hash-like behavior. Both non-shared and shared instances are impacted if doing so. Although likely fast enough for many use cases, the OO interface is recommended for best performance.

Accessing an item is likely to involve moving its key to the top of the cache. Various methods described below state with Reorder: Yes or Reorder: No as an indication.

The methods keys, pairs, and values return the most frequently accessed items from the upper section of the cache first before the lower section. Returned values may not be ordered as expected. This abnormally is normal for this hybrid LRU-plain implementation. It comes from fetches not involving LRU movement on keys residing in the upper section of the cache.

When max_age is set, accessing an item which has expired will behave similarly to a non-existing item.

MCE::Shared::Cache->new ( { options }, key, value [, key, value, ... ] )

MCE::Shared->cache ( { options }, key, value [, key, value, ... ] )

Constructs a new object.

# non-shared or local construction for use by a single process

use MCE::Shared::Cache;

$ca = MCE::Shared::Cache->new(); # max_keys => undef, max_age => undef
$ca = MCE::Shared::Cache->new( { max_keys => 500 }, @pairs );

$ca = MCE::Shared::Cache->new( max_keys => "unlimited", max_age => "never" );
$ca = MCE::Shared::Cache->new( max_keys => undef, max_age => undef ); # ditto
$ca = MCE::Shared::Cache->new( max_keys => 500, max_age => "1 hour" );
$ca = MCE::Shared::Cache->new( max_keys => "4 KiB" ); # 4*1024
$ca = MCE::Shared::Cache->new( max_keys => "1 MiB" ); # 1*1024*1024

$ca = MCE::Shared::Cache->new( max_age  => "43200 seconds" );
$ca = MCE::Shared::Cache->new( max_age  => 43200 );   # ditto
$ca = MCE::Shared::Cache->new( max_age  => "720 minutes" );
$ca = MCE::Shared::Cache->new( max_age  => "12 hours" );
$ca = MCE::Shared::Cache->new( max_age  => "0.5 days" );
$ca = MCE::Shared::Cache->new( max_age  => "1 week" );
$ca = MCE::Shared::Cache->new( max_age  => undef );   # no expiration
$ca = MCE::Shared::Cache->new( max_age  => 0 );       # now

$ca->assign( @pairs );

# construction for sharing with other threads and processes

use MCE::Shared;

$ca = MCE::Shared->cache(); # max_keys => undef, max_age => undef
$ca = MCE::Shared->cache( { max_keys => 500 }, @pairs );

$ca = MCE::Shared->cache( max_keys => "unlimited", max_age => "never" );
$ca = MCE::Shared->cache( max_keys => undef, max_age => undef ); # ditto
$ca = MCE::Shared->cache( max_keys => 500, max_age => "1 hour" );
$ca = MCE::Shared->cache( max_keys => "4 KiB" ); # 4*1024
$ca = MCE::Shared->cache( max_keys => "1 MiB" ); # 1*1024*1024

$ca = MCE::Shared->cache( max_age  => "43200 seconds" );
$ca = MCE::Shared->cache( max_age  => 43200 );   # ditto
$ca = MCE::Shared->cache( max_age  => "720 minutes" );
$ca = MCE::Shared->cache( max_age  => "12 hours" );
$ca = MCE::Shared->cache( max_age  => "0.5 days" );
$ca = MCE::Shared->cache( max_age  => "1 week" );
$ca = MCE::Shared->cache( max_age  => undef );   # no expiration
$ca = MCE::Shared->cache( max_age  => 0 );       # now

$ca->assign( @pairs );

Reorder: Yes, when given key-value pairs contain duplicate keys

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

Clears the cache, then sets multiple key-value pairs and returns the number of keys stored in the cache. This is equivalent to clear, mset.

$len = $ca->assign( "key1" => "val1", "key2" => "val2" );

Reorder: Yes, when given key-value pairs contain duplicate keys

clear

Removes all key-value pairs from the cache.

$ca->clear;
%{$ca} = ();

delete ( key )

Deletes and returns the value by given key or undef if the key does not exists in the cache.

$val = $ca->delete( "some_key" );
$val = delete $ca->{ "some_key" };

del

del is an alias for delete.

exists ( key )

Determines if a key exists in the cache.

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

Reorder: No

get ( key )

Gets the value of a cache key or undef if the key does not exists. LRU reordering occurs only if the key is found in the lower section of the cache. See peek to not promote the key internally to the top of the list.

$val = $ca->get( "some_key" );
$val = $ca->{ "some_key" };

Reorder: Yes

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

When max_age is set, prunes any expired keys at the head of the list.

Returns a code reference for iterating a list of key-value pairs stored in the cache 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 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 undef value is returned for deleted keys.

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

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

Reorder: No

iterator ( "query string" )

When max_age is set, prunes any expired keys at the head of the list.

Returns a code reference for iterating a list of key-value pairs that match the given criteria. It returns an empty list if the search found nothing. The syntax for the query string is described above.

$iter = $ca->iterator( "val eq some_value" );
$iter = $ca->iterator( "key eq some_key :AND val =~ /sun|moon|air|wind/" );
$iter = $ca->iterator( "val eq sun :OR val eq moon :OR val eq foo" );
$iter = $ca->iterator( "key =~ /$pattern/" );

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

Reorder: No

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

When max_age is set, prunes any expired keys at the head of the list.

Returns all keys in the cache by most frequently accessed when no arguments are given. Otherwise, returns the given keys in the same order. Keys that do not exist will have the undef value. In scalar context, returns the size of the cache.

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

Reorder: No

keys ( "query string" )

When max_age is set, prunes any expired keys at the head of the list.

Returns only keys that match the given criteria. It returns an empty list if the search found nothing. The syntax for the query string is described above. In scalar context, returns the size of the resulting list.

@keys = $ca->keys( "val eq some_value" );
@keys = $ca->keys( "key eq some_key :AND val =~ /sun|moon|air|wind/" );
@keys = $ca->keys( "val eq sun :OR val eq moon :OR val eq foo" );
$len  = $ca->keys( "key =~ /$pattern/" );

Reorder: No

len ( key )

When max_age is set, prunes any expired keys at the head of the list.

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

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

Reorder: Yes, only when key is given

max_age ( [ secs ] )

Returns the maximum age set on the cache or "never" if not defined internally. It sets the default expiry time when seconds is given.

$age = $ca->max_age;

$ca->max_age( "43200 seconds" );
$ca->max_age( 43200 );     # ditto
$ca->max_age( "720 minutes" );
$ca->max_age( "12 hours" );
$ca->max_age( "0.5 days" );
$ca->max_age( "1 week" );
$ca->max_age( undef );     # no expiration
$ca->max_age( 0 );         # now

max_keys ( [ size ] )

Returns the size limit set on the cache or "unlimited" if not defined internally. When size is given, it adjusts the cache accordingly to the new size by pruning the head of the list if necessary.

$size = $ca->max_keys;

$ca->max_keys( undef );    # unlimited
$ca->max_keys( "4 KiB" );  # 4*1024
$ca->max_keys( "1 MiB" );  # 1*1024*1024
$ca->max_keys( 500 );

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

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

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

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

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

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

Reorder: No

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

Gets the values of all given keys. It returns undef for keys which do not exists in the cache.

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

Reorder: Yes

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

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

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

Reorder: Yes

merge

merge is an alias for mset.

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

When max_age is set, prunes any expired keys at the head of the list.

Returns key-value pairs in the cache by most frequently accessed 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 undef value. In scalar context, returns the size of the cache.

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

Reorder: No

pairs ( "query string" )

When max_age is set, prunes any expired keys at the head of the list.

Returns only key-value pairs that match the given criteria. It returns an empty list if the search found nothing. The syntax for the query string is described above. In scalar context, returns the size of the resulting list.

@pairs = $ca->pairs( "val eq some_value" );
@pairs = $ca->pairs( "key eq some_key :AND val =~ /sun|moon|air|wind/" );
@pairs = $ca->pairs( "val eq sun :OR val eq moon :OR val eq foo" );
$len   = $ca->pairs( "key =~ /$pattern/" );

Reorder: No

peek ( key )

Same as get without changing the order of the keys. Gets the value of a cache key or undef if the key does not exists.

$val = $ca->get( "some_key" );
$val = $ca->{ "some_key" };

Reorder: No

pipeline ( [ func1, @args ], [ func2, @args ], ... )

Combines multiple commands for the object to be processed serially. For shared objects, the call is made atomically due to single IPC to the shared-manager process. The pipeline method is fully wantarray-aware and receives a list of commands and their arguments. In scalar or list context, it returns data from the last command in the pipeline.

@vals = $ca->pipeline(                     # ( "a_a", "b_b", "c_c" )
   [ "set", foo => "a_a" ],
   [ "set", bar => "b_b" ],
   [ "set", baz => "c_c" ],
   [ "mget", qw/ foo bar baz / ]
);

$len = $ca->pipeline(                      # 3, same as $ca->len
   [ "set", foo => "i_i" ],
   [ "set", bar => "j_j" ],
   [ "set", baz => "k_k" ],
   [ "len" ]
);

$ca->pipeline(
   [ "set", foo => "m_m" ],
   [ "set", bar => "n_n" ],
   [ "set", baz => "o_o" ]
);

Reorder: Very likely, see API on given method

pipeline_ex ( [ func1, @args ], [ func2, @args ], ... )

Same as pipeline, but returns data for every command in the pipeline.

@vals = $ca->pipeline_ex(                  # ( "a_a", "b_b", "c_c" )
   [ "set", foo => "a_a" ],
   [ "set", bar => "b_b" ],
   [ "set", baz => "c_c" ]
);

Reorder: Very likely, see API on given command

purge ( )

Remove all tombstones and expired data from the cache.

$ca->purge;

remove

remove is an alias for delete.

set ( key, value [, expires_in ] )

Sets the value of the given cache key and returns its new value. Optionally in v1.839 and later releases, give the number of seconds before the key is expired.

$val = $ca->set( "key", "value" );
$val = $ca->{ "key" } = "value";

$val = $ca->set( "key", "value", 3600  );  # or "60 minutes"
$val = $ca->set( "key", "value", undef );  # or "never"
$val = $ca->set( "key", "value", 0     );  # or "now"

$val = $ca->set( "key", "value", "2 seconds" );  # or "2s"
$val = $ca->set( "key", "value", "2 minutes" );  # or "2m"
$val = $ca->set( "key", "value", "2 hours"   );  # or "2h"
$val = $ca->set( "key", "value", "2 days"    );  # or "2d"
$val = $ca->set( "key", "value", "2 weeks"   );  # or "2w"

Reorder: Yes

setnx ( key, value [, expires_in ] )

Sets the value of a hash key, only if the key does not exist. Returns a 1 for new key or 0 if the key already exists and no operation was performed. Optionally, give the number of seconds before the key is expired.

$ret = $ca->setnx( "key", "value" );

Current API available since 1.872.

Reorder: Yes

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

When max_age is set, prunes any expired keys at the head of the list.

Returns all values in the cache by most frequently accessed when no arguments are given. Otherwise, returns values for the given keys in the same order. Keys that do not exist will have the undef value. In scalar context, returns the size of the cache.

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

Reorder: No

values ( "query string" )

When max_age is set, prunes any expired keys at the head of the list.

Returns only values that match the given criteria. It returns an empty list if the search found nothing. The syntax for the query string is described above. In scalar context, returns the size of the resulting list.

@vals = $ca->values( "val eq some_value" );
@vals = $ca->values( "key eq some_key :AND val =~ /sun|moon|air|wind/" );
@vals = $ca->values( "val eq sun :OR val eq moon :OR val eq foo" );
$len  = $ca->values( "key =~ /$pattern/" );

Reorder: No

vals

vals is an alias for values.

SUGAR METHODS

This module is equipped with sugar methods to not have to call set and get explicitly. In shared context, the benefit is atomicity and reduction in inter-process communication.

The API resembles a subset of the Redis primitives https://redis.io/commands#strings with key representing the cache key.

Optionally in v1.839 and later releases, give the number of seconds before the key is expired, similarly to set.

append ( key, string [, expires_in ] )

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

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

Reorder: Yes

decr ( key [, expires_in ] )

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

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

Reorder: Yes

decrby ( key, number [, expires_in ] )

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

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

Reorder: Yes

getdecr ( key [, expires_in ] )

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

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

Reorder: Yes

getincr ( key [, expires_in ] )

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

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

Reorder: Yes

getset ( key, value [, expires_in ] )

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

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

Reorder: Yes

incr ( key [, expires_in ] )

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

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

Reorder: Yes

incrby ( key, number [, expires_in ] )

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

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

Reorder: Yes

INTERNAL METHODS

Internal Sereal freeze-thaw hooks for exporting shared-cache object.

FREEZE
THAW

Internal Storable freeze-thaw hooks for exporting shared-cache object.

STORABLE_freeze
STORABLE_thaw

PERFORMANCE TESTING

One might want to benchmark this module. If yes, remember to use the non-shared construction for running on a single core.

use MCE::Shared::Cache;

my $cache = MCE::Shared::Cache->new( max_keys => 500_000 );

Otherwise, the following is a parallel version for a benchmark script found on the web. The serial version was created by Celogeek for benchmarking various caching modules.

The MCE progress option makes it possible to track progress while running parallel. This script involves IPC to and from the shared-manager process, where the data resides. In regards to IPC, fetches may take longer on Linux versus Darwin or FreeBSD.

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

use Digest::MD5 qw( md5_base64 );
use Time::HiRes qw( time );
use MCE 1.814;
use MCE::Shared;

$| = 1; srand(0);

# construct shared variables
# serialization is handled automatically

my $c     = MCE::Shared->cache( max_keys => 500_000 );
my $found = MCE::Shared->scalar( 0 );

# construct and spawn MCE workers
# workers increment a local variable $f

my $mce = MCE->new(
    chunk_size  => 4000,
    max_workers => 4,
    user_func   => sub {
        my ($mce, $chunk_ref, $chunk_id) = @_;
        if ( $mce->user_args()->[0] eq 'setter' ) {
            for ( @{ $chunk_ref } ) { $c->set($_, {md5 => $_})  }
        }
        else {
            my $f = 0;
            for ( @{ $chunk_ref } ) { $f++ if ref $c->get($_) eq 'HASH' }
            $found->incrby($f);
        }
    }
)->spawn();

say "Mapping";
my @todo = map { md5_base64($_) } ( 1 .. 600_000 );

say "Starting";
my ( $read, $write );

{
    my $s = time;
    $mce->process({
        progress  => sub { print "Write: $_[0]\r" },
        user_args => [ 'setter' ],
    }, \@todo);
    $write = time - $s;
}

say "Write: ", sprintf("%0.3f", scalar(@todo) / $write);

{
    my $s = time;
    $found->set(0);
    $mce->process({
        progress  => sub { print "Read $_[0]\r" },
        user_args => [ 'getter' ],
    }, \@todo);
    $read = time - $s;
}

$mce->shutdown();

say "Read : ", sprintf("%0.3f", scalar(@todo) / $read);
say "Found: ", $found->get();

The progress option is further described on Metacpan. Several examples are provided, accommodating all input data-types in MCE.

Progress Demonstrations

SEE ALSO

INDEX

MCE, MCE::Hobo, MCE::Shared

AUTHOR

Mario E. Roy, <marioeroy AT gmail DOT com>