MCE::Shared(3)

πŸ“¦
version 1.893 Β· 4 versions
, in epel 10

πŸ’– NAME πŸ’–

okay so this whole page is MCE::Shared(3) β€” literally the MCE extension for sharing data supporting threads and processes. That’s the name line folded in near the top, bestie πŸ’….

πŸŽ€ VERSION πŸŽ€

This document describes MCE::Shared version 1.893.

✨ SYNOPSIS ✨

Here’s the full vibe: OO construction first, then tie construction, then a whole demonstration because we love a worked example. Keep your eyes on the exact code, no cap πŸ‘‘

# OO construction.

use MCE::Shared;

my $ar = MCE::Shared->array( @list );
my $ca = MCE::Shared->cache( max_keys => 500, max_age => 60 );
my $cv = MCE::Shared->condvar( 0 );
my $fh = MCE::Shared->handle( '>>', \*STDOUT ) or die "$!";
my $ha = MCE::Shared->hash( @pairs );
my $oh = MCE::Shared->ordhash( @pairs );
my $db = MCE::Shared->minidb();
my $qu = MCE::Shared->queue( await => 1, fast => 0 );
my $va = MCE::Shared->scalar( $value );
my $se = MCE::Shared->sequence( $begin, $end, $step, $fmt );
my $ob = MCE::Shared->share( $blessed_object );

# Mutex locking is supported for all shared objects since 1.841.
# Previously only shared C<condvar>s allowed locking.

$ar->lock;
$ar->unlock;
...
$ob->lock;
$ob->unlock;

# The Perl-like mce_open function is available since 1.002.

mce_open my $fh, ">>", "/foo/bar.log" or die "open error: $!";

# Tie construction. The module API option is available since 1.825.

use v5.10;
use MCE::Flow;
use MCE::Shared;

my %args  = ( max_keys => 500, max_age => 60 );
my @pairs = ( foo => 'bar', woo => 'baz' );
my @list  = ( 'a' .. 'z' );

tie my $va1, 'MCE::Shared', { module => 'MCE::Shared::Scalar' }, 0;
tie my @ar1, 'MCE::Shared', { module => 'MCE::Shared::Array' }, @list;
tie my %ca1, 'MCE::Shared', { module => 'MCE::Shared::Cache' }, %args;
tie my %ha1, 'MCE::Shared', { module => 'MCE::Shared::Hash' }, @pairs;
tie my %oh1, 'MCE::Shared', { module => 'MCE::Shared::Ordhash' }, @pairs;
tie my %oh2, 'MCE::Shared', { module => 'Hash::Ordered' }, @pairs;
tie my %oh3, 'MCE::Shared', { module => 'Tie::IxHash' }, @pairs;
tie my $cy1, 'MCE::Shared', { module => 'Tie::Cycle' }, [ 1 .. 8 ];
tie my $va2, 'MCE::Shared', { module => 'Tie::StdScalar' }, 'hello';
tie my @ar3, 'MCE::Shared', { module => 'Tie::StdArray' }, @list;
tie my %ha2, 'MCE::Shared', { module => 'Tie::StdHash' }, @pairs;
tie my %ha3, 'MCE::Shared', { module => 'Tie::ExtraHash' }, @pairs;

tie my $cnt, 'MCE::Shared', 0; # default MCE::Shared::Scalar
tie my @foo, 'MCE::Shared';    # default MCE::Shared::Array
tie my %bar, 'MCE::Shared';    # default MCE::Shared::Hash

tie my @ary, 'MCE::Shared', qw( a list of values );
tie my %ha,  'MCE::Shared', key1 => 'val1', key2 => 'val2';
tie my %ca,  'MCE::Shared', { max_keys => 500, max_age => 60 };
tie my %oh,  'MCE::Shared', { ordered => 1 }, key1 => 'value';

# Mutex locking is supported for all shared objects since 1.841.

tied($va1)->lock;
tied($va1)->unlock;
...
tied(%bar)->lock;
tied(%bar)->unlock;

# Demonstration.

my $mutex = MCE::Mutex->new;

mce_flow {
   max_workers => 4
},
sub {
   my ( $mce ) = @_;
   my ( $pid, $wid ) = ( MCE->pid, MCE->wid );

   # Locking is necessary when multiple workers update the same
   # element. The reason is that it may involve 2 trips to the
   # shared-manager process: fetch and store in this case.

   $mutex->enter( sub { $cnt += 1 } );

   # Otherwise, locking is optional for unique elements.

   $foo[ $wid - 1 ] = $pid;
   $bar{ $pid }     = $wid;

   # From 1.841 onwards, all shared objects include mutex locking
   # to not need to construct MCE::Mutex separately.

   tied($va1)->lock;
   $va1 += 1;
   tied($va1)->unlock;

   return;
};

say "scalar : $cnt";
say "scalar : $va1";
say " array : $_" for (@foo);
say "  hash : $_ => $bar{$_}" for (sort keys %bar);

__END__

# Output

scalar : 4
scalar : 4
 array : 37847
 array : 37848
 array : 37849
 array : 37850
  hash : 37847 => 1
  hash : 37848 => 2
  hash : 37849 => 3
  hash : 37850 => 4

🌸 DESCRIPTION 🌸

This module provides data sharing capabilities for MCE supporting threads and processes. Also, MCE::Hobo provides threads-like parallelization for running code asynchronously. Periodt.

πŸ”₯ EXTRA FUNCTIONALITY πŸ”₯

MCE::Shared enables extra functionality on systems with IO::FDPass installed. Without it, MCE::Shared is unable to send file descriptors to the shared-manager process. The use applies to Condvar, Queue, and Handle (mce_open). IO::FDpass isn’t used for anything else.

use MCE::Shared;

# One may want to start the shared-manager early.

MCE::Shared->start();

# Typically, the shared-manager is started automatically when
# constructing a shared object.

my $ca = MCE::Shared->cache( max_keys => 500 );

# IO::FDPass is necessary for constructing a shared condvar or queue
# while the manager is running in order to send file descriptors
# associated with the object.

# Workers block using a socket handle for ->wait and ->timedwait.

my $cv = MCE::Shared->condvar();

# Workers block using a socket handle for ->dequeue and ->await.

my $q1 = MCE::Shared->queue();
my $q2 = MCE::Shared->queue( await => 1 );

For platforms where IO::FDPass isn’t possible (e.g. Cygwin, Android), construct condvar and queue before other classes. The shared-manager process will be delayed until sharing other classes (e.g. Array, Hash) or starting explicitly.

use MCE::Shared;

my $has_IO_FDPass = $INC{'IO/FDPass.pm'} ? 1 : 0;

my $cv  = MCE::Shared->condvar( 0 );
my $que = MCE::Shared->queue( fast => 1 );

MCE::Shared->start() unless $has_IO_FDPass;

my $ha = MCE::Shared->hash();  # started implicitly

Note that MCE starts the shared-manager, prior to spawning workers, if not yet started. Ditto for MCE::Hobo.

Regarding mce_open, IO::FDPass is needed for constructing a shared-handle from a non-shared handle not yet available inside the shared-manager process. The workaround is to have the non-shared handle made before the shared-manager is started. Passing a file by reference is fine for the three STD* handles.

# The shared-manager knows of \*STDIN, \*STDOUT, \*STDERR.

mce_open my $shared_in,  "<",  \*STDIN;   # ok
mce_open my $shared_out, ">>", \*STDOUT;  # ok
mce_open my $shared_err, ">>", \*STDERR;  # ok
mce_open my $shared_fh1, "<",  "/path/to/sequence.fasta";  # ok
mce_open my $shared_fh2, ">>", "/path/to/results.log";     # ok

mce_open my $shared_fh, ">>", \*NON_SHARED_FH;  # requires IO::FDPass

The IO::FDPass module is known to work reliably on most platforms. Install 1.1 or later to rid of limitations described above.

perl -MIO::FDPass -le "print 'Cheers! Perl has IO::FDPass.'"

🌈 DATA SHARING 🌈

Here’s the mapping, bestie β€” each shared constructor lines up with its class like this:

  • MCE::Shared->array β†’ MCE::Shared::Array
  • MCE::Shared->cache β†’ MCE::Shared::Cache
  • MCE::Shared->condvar β†’ MCE::Shared::Condvar
  • MCE::Shared->handle β†’ MCE::Shared::Handle
  • MCE::Shared->hash β†’ MCE::Shared::Hash
  • MCE::Shared->minidb β†’ MCE::Shared::Minidb
  • MCE::Shared->ordhash β†’ MCE::Shared::Ordhash
  • MCE::Shared->queue β†’ MCE::Shared::Queue
  • MCE::Shared->scalar β†’ MCE::Shared::Scalar
  • MCE::Shared->sequence β†’ MCE::Shared::Sequence

Below, synopsis for sharing classes included with MCE::Shared.

use MCE::Shared;

# short form

$ar = MCE::Shared->array( @list );
$ca = MCE::Shared->cache( max_keys => 500, max_age => 60 );
$cv = MCE::Shared->condvar( 0 );
$fh = MCE::Shared->handle( ">>", \*STDOUT ); # see mce_open below
$ha = MCE::Shared->hash( @pairs );
$db = MCE::Shared->minidb();
$oh = MCE::Shared->ordhash( @pairs );
$qu = MCE::Shared->queue( await => 1, fast => 0 );
$va = MCE::Shared->scalar( $value );
$se = MCE::Shared->sequence( $begin, $end, $step, $fmt );

mce_open my $fh, ">>", \*STDOUT or die "open error: $!";

# long form

$ar = MCE::Shared->share( { module => 'MCE::Shared::Array'    }, ... );
$ca = MCE::Shared->share( { module => 'MCE::Shared::Cache'    }, ... );
$cv = MCE::Shared->share( { module => 'MCE::Shared::Condvar'  }, ... );
$fh = MCE::Shared->share( { module => 'MCE::Shared::Handle'   }, ... );
$ha = MCE::Shared->share( { module => 'MCE::Shared::Hash'     }, ... );
$db = MCE::Shared->share( { module => 'MCE::Shared::Minidb'   }, ... );
$oh = MCE::Shared->share( { module => 'MCE::Shared::Ordhash'  }, ... );
$qu = MCE::Shared->share( { module => 'MCE::Shared::Queue'    }, ... );
$va = MCE::Shared->share( { module => 'MCE::Shared::Scalar'   }, ... );
$se = MCE::Shared->share( { module => 'MCE::Shared::Sequence' }, ... );

The restriction for sharing classes not included with MCE::Shared is that the object must not have file-handles nor code-blocks.

$oh = MCE::Shared->share( { module => 'Hash::Ordered' }, ... );
open ( filehandle, expr )
open ( filehandle, mode, expr )
open ( filehandle, mode, reference )

In version 1.002 and later, constructs a new object by opening the file whose filename is given by expr, and associates it with filehandle. When omitting error checking at the application level, MCE::Shared emits a message and stop if open fails.

See MCE::Shared::Handle for chunk IO demonstrations.

{
  use MCE::Shared::Handle;

  # "non-shared" or "local construction" for use by a single process
  MCE::Shared::Handle->open( my $fh, "<", "file.log" ) or die "$!";
  MCE::Shared::Handle::open  my $fh, "<", "file.log"   or die "$!";

  # mce_open is an alias for MCE::Shared::Handle::open
  mce_open my $fh, "<", "file.log" or die "$!";
}

{
  use MCE::Shared;

  # construction for "sharing" with other threads and processes
  MCE::Shared->open( my $fh, "<", "file.log" ) or die "$!";
  MCE::Shared::open  my $fh, "<", "file.log"   or die "$!";

  # mce_open is an alias for MCE::Shared::open
  mce_open my $fh, "<", "file.log" or die "$!";
}
mce_open ( filehandle, expr )
mce_open ( filehandle, mode, expr )
mce_open ( filehandle, mode, reference )

Native Perl-like syntax to open a shared-file for reading:

use MCE::Shared;

# mce_open is exported by MCE::Shared or MCE::Shared::Handle.
# It creates a shared file handle with MCE::Shared present
# or a non-shared handle otherwise.

mce_open my $fh, "< input.txt"     or die "open error: $!";
mce_open my $fh, "<", "input.txt"  or die "open error: $!";
mce_open my $fh, "<", \*STDIN      or die "open error: $!";

and for writing:

mce_open my $fh, "> output.txt"    or die "open error: $!";
mce_open my $fh, ">", "output.txt" or die "open error: $!";
mce_open my $fh, ">", \*STDOUT     or die "open error: $!";

πŸ¦‹ num_sequence πŸ¦‹

num_sequence is an alias for sequence.

✨ DEEPLY SHARING ✨

okay so bestie, you can construct a deeply-shared object from a non-blessed data structure with the _DEEPLY_ option πŸ’…. the data lowkey resides in the shared-manager thread or process. and if you want a non-blessed data structure back? specify the unbless option to export β€” the export method gets its own little moment later in the Common API section, iykyk ✨.

use MCE::Hobo;
use MCE::Shared;
use Data::Dumper;

my @data = ('wind', 'air', [ 'a', 'b', { foo => 'bar' }, 'c' ]);
my $shared_data = MCE::Shared->share({_DEEPLY_ => 1}, \@data);

MCE::Hobo->create(sub {
   $shared_data->[2][2]{hi} = 'there';
   $shared_data->[2][4]{hi} = 'there';
})->join;

print $shared_data->get(2)->get(2)->get('hi'), "\n";
print $shared_data->[2][2]{hi}, "\n\n";  # or Perl-like behavior

print Dumper($shared_data->export({ unbless => 1 })), "\n";

__END__

# Output

there    # get method(s)
there    # dereferencing

$VAR1 = [
  'wind',
  'air',
  [
    'a',
    'b',
    {
      'foo' => 'bar',
      'hi' => 'there'
    },
    'c',
    {
      'hi' => 'there'
    }
  ]
];

the following is a demo of a shared tied-hash variable πŸŽ€. before you dive into the actual code, notice the dump function making a call to export explicitly for objects of type MCE::Shared::Object β€” this is necessary to retrieve the data from the shared-manager process, no cap.

use MCE::Shared;

sub _dump {
   require Data::Dumper unless $INC{'Data/Dumper.pm'};
   no warnings 'once';

   local $Data::Dumper::Varname  = 'VAR';
   local $Data::Dumper::Deepcopy = 1;
   local $Data::Dumper::Indent   = 1;
   local $Data::Dumper::Purity   = 1;
   local $Data::Dumper::Sortkeys = 0;
   local $Data::Dumper::Terse    = 0;

   ( ref $_[0] eq 'MCE::Shared::Object' )
      ? print Data::Dumper::Dumper( $_[0]->export ) . "\n"
      : print Data::Dumper::Dumper( $_[0] ) . "\n";
}

tie my %abc, 'MCE::Shared';

my @parents = qw( a b c );
my @children = qw( 1 2 3 4 );

for my $parent ( @parents ) {
   for my $child ( @children ) {
      $abc{ $parent }{ $child } = 1;
   }
}

_dump( tied( %abc ) );

__END__

# Output

$VAR1 = bless( {
  'c' => bless( {
    '1' => '1',
    '4' => '1',
    '3' => '1',
    '2' => '1'
  }, 'MCE::Shared::Hash' ),
  'a' => bless( {
    '1' => '1',
    '4' => '1',
    '3' => '1',
    '2' => '1'
  }, 'MCE::Shared::Hash' ),
  'b' => bless( {
    '1' => '1',
    '4' => '1',
    '3' => '1',
    '2' => '1'
  }, 'MCE::Shared::Hash' )
}, 'MCE::Shared::Hash' );

dereferencing provides hash-like behavior for hash and ordhash πŸ’–. array-like behavior is allowed for array, not shown below πŸ‘€.

use MCE::Shared;
use Data::Dumper;

my $abc = MCE::Shared->hash;

my @parents = qw( a b c );
my @children = qw( 1 2 3 4 );

for my $parent ( @parents ) {
   for my $child ( @children ) {
      $abc->{ $parent }{ $child } = 1;
   }
}

print Dumper( $abc->export({ unbless => 1 }) ), "\n";

each level in a deeply structure requires a separate trip to the shared-manager process πŸ¦‹. the included MCE::Shared::Minidb module provides optimized methods for working with hash of hashes HoH and hash of arrays HoA 🫢.

use MCE::Shared;
use Data::Dumper;

my $abc = MCE::Shared->minidb;

my @parents = qw( a b c );
my @children = qw( 1 2 3 4 );

for my $parent ( @parents ) {
   for my $child ( @children ) {
      $abc->hset($parent, $child, 1);
   }
}

print Dumper( $abc->export ), "\n";

for further reading, see MCE::Shared::Minidb πŸ“š.


✨ OBJECT SHARING ✨

🌸 MCE::Shared->share 🌸

this class method transfers the blessed-object to the shared-manager process and returns a MCE::Shared::Object containing the SHARED_ID πŸ’…. starting with the 1.827 release, the module option sends parameters to the shared-manager, where the object is then constructed. this is useful for classes involving XS code or a file handle πŸ”₯.

use MCE::Shared;

{
  use Math::BigFloat try => 'GMP';
  use Math::BigInt   try => 'GMP';

  my $bf  = MCE::Shared->share({ module => 'Math::BigFloat' }, 0);
  my $bi  = MCE::Shared->share({ module => 'Math::BigInt'   }, 0);
  my $y   = 1e9;

  $bf->badd($y);  # addition (add $y to shared BigFloat object)
  $bi->badd($y);  # addition (add $y to shared BigInt object)
}

{
  use Bio::Seq;
  use Bio::SeqIO;

  my $seq_io = MCE::Shared->share({ module => 'Bio::SeqIO' },
     -file    => ">/path/to/fasta/file.fa",
     -format  => 'Fasta',
     -verbose => -1,
  );

  my $seq_obj = Bio::Seq->new(
     -display_id => "name", -desc => "desc", -seq => "seq",
     -alphabet   => "dna"
  );

  $seq_io->write_seq($seq_obj);  # write to shared SeqIO handle
}

{
  my $oh1 = MCE::Shared->share({ module => 'MCE::Shared::Ordhash' });
  my $oh2 = MCE::Shared->ordhash();  # same thing

  $oh1->assign( @pairs );
  $oh2->assign( @pairs );
}

{
  my ($ho_shared, $ho_nonshared);

  $ho_shared = MCE::Shared->share({ module => 'Hash::Ordered' });
  $ho_shared->push( @pairs );

  $ho_nonshared = $ho_shared->export();   # back to non-shared
  $ho_nonshared = $ho_shared->destroy();  # including shared destruction
}

the following provides long and short forms for constructing a shared array, hash, or scalar object 🌈.

use MCE::Shared;

my $a1 = MCE::Shared->share( { module => 'MCE::Shared::Array' }, @list );
my $a2 = MCE::Shared->share( [ @list ] );
my $a3 = MCE::Shared->array( @list );

my $h1 = MCE::Shared->share( { module => 'MCE::Shared::Hash' }, @pairs );
my $h2 = MCE::Shared->share( { @pairs } );
my $h3 = MCE::Shared->hash( @pairs );

my $s1 = MCE::Shared->share( { module => 'MCE::Shared::Scalar' }, 20 );
my $s2 = MCE::Shared->share( \do{ my $o = 20 } );
my $s3 = MCE::Shared->scalar( 20 );

when the module option is given, one may optionally specify the constructor function via the new option ✨. this is necessary for the CDB_File module, which provides two different objects. one is created by new (default), and accessed by insert and finish. the other is created by TIEHASH, and accessed by FETCH 🧚.

use MCE::Hobo;
use MCE::Shared;

# populate CDB file
my $cdb = MCE::Shared->share({ module => 'CDB_File' }, 't.cdb', "t.cdb.$$")
   or die "$!\n";

$cdb->insert( $_ => $_ ) for ('aa'..'zz');
$cdb->finish;

# use CDB file
my $cdb1 = tie my %hash, 'MCE::Shared', { module => 'CDB_File' }, 't.cdb';

# same thing, without involving TIE and extra hash variable
my $cdb2 = MCE::Shared->share(
   { module => 'CDB_File', new => 'TIEHASH' }, 't.cdb'
);

print $hash{'aa'}, "\n";
print $cdb1->FETCH('bb'), "\n";
print $cdb2->FETCH('cc'), "\n";

# rewind may be omitted on first use for parallel iteration
$cdb2->rewind;

for ( 1 .. 3 ) {
   mce_async {
      while ( my ($k,$v) = $cdb2->next ) {
         print "[$$] $k => $v\n";
      }
   };
}

MCE::Hobo->waitall;

✨ DBM SHARING ✨

Okay so, constructing a shared DBM object is possible starting with the 1.827 release, bestie. πŸ’… Supported modules are AnyDBM_File, BerkeleyDB, CDB_File, DB_File, GDBM_File, NDBM_File, ODBM_File, SDBM_File, SQLite_File, Tie::Array::DBD, and Tie::Hash::DBD. The list includes Tokyo Cabinet (http://fallabs.com/tokyocabinet/) and Kyoto Cabinet (http://fallabs.com/kyotocabinet/). Also, see the forked version by Altice Labs (https://github.com/alticelabs/kyoto) β€” it contains an updated "kyotocabinet" folder that builds successfully with recent compilers. πŸ› οΈβœ¨

Freeze-thaw during STORE-FETCH (for complex data) is handled automatically using Serial 3.015+ (if available) or Storable, no cap. 🧊 Below are the constructions for sharing the various DBM modules. The construction for CDB_File is given in the prior section, so go peek there if you need it. πŸ’–

πŸ—ƒοΈ AnyDBM_File

BEGIN { @AnyDBM_File::ISA = qw( DB_File GDBM_File NDBM_File ODBM_File ); }

use MCE::Shared;
use Fcntl;
use AnyDBM_File;

tie my %h1, 'MCE::Shared', { module => 'AnyDBM_File' },
   'foo_a', O_CREAT|O_RDWR or die "open error: $!";

πŸ—ƒοΈ BerkeleyDB

use MCE::Shared;
use BerkeleyDB;

tie my %h1, 'MCE::Shared', { module => 'BerkeleyDB::Hash' },
   -Filename => 'foo_a', -Flags => DB_CREATE
      or die "open error: $!";

tie my %h2, 'MCE::Shared', { module => 'BerkeleyDB::Btree' },
   -Filename => 'foo_b', -Flags => DB_CREATE
      or die "open error: $!";

tie my @a1, 'MCE::Shared', { module => 'BerkeleyDB::Queue' },
   -Filename => 'foo_c', -Flags => DB_CREATE
      or die "open error: $!";

tie my @a2, 'MCE::Shared', { module => 'BerkeleyDB::Recno' },
   -Filename => 'foo_d', -Flags => DB_CREATE -Len => 20
      or die "open error: $!";

πŸ—ƒοΈ DB_File

use MCE::Shared;
use Fcntl;
use DB_File;

# Use pre-defined references ( $DB_HASH, $DB_BTREE, $DB_RECNO ).

tie my %h1, 'MCE::Shared', { module => 'DB_File' },
   'foo_a', O_CREAT|O_RDWR, 0640, $DB_HASH or die "open error: $!";

tie my %h2, 'MCE::Shared', { module => 'DB_File' },
   'foo_b', O_CREAT|O_RDWR, 0640, $DB_BTREE or die "open error: $!";

tie my @a1, 'MCE::Shared', { module => 'DB_File' },
   'foo_c', O_CREAT|O_RDWR, 0640, $DB_RECNO or die "open error: $!";

# Changing defaults - see DB_File for valid options.

my $opt_h = DB_File::HASHINFO->new();
my $opt_b = DB_File::BTREEINFO->new();
my $opt_r = DB_File::RECNOINFO->new();

$opt_h->{'cachesize'} = 12345;

tie my %h3, 'MCE::Shared', { module => 'DB_File' },
   'foo_d', O_CREAT|O_RDWR, 0640, $opt_h or die "open error: $!";

πŸ—ƒοΈ KyotoCabinet

πŸ—ƒοΈ TokyoCabinet

These two share one construction block, so here it is in all its glory, bestie: 🌸

use MCE::Shared;
use KyotoCabinet;
use TokyoCabinet;

# file extension denotes hash database

tie my %h1, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, 'foo.kch',
   KyotoCabinet::DB::OWRITER | KyotoCabinet::DB::OCREATE
      or die "open error: $!";

tie my %h2, 'MCE::Shared', { module => 'TokyoCabinet::HDB' }, 'foo.tch',
   TokyoCabinet::HDB::OWRITER | TokyoCabinet::HDB::OCREAT
      or die "open error: $!";

# file extension denotes tree database

tie my %h3, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, 'foo.kct',
   KyotoCabinet::DB::OWRITER | KyotoCabinet::DB::OCREATE
      or die "open error: $!";

tie my %h4, 'MCE::Shared', { module => 'TokyoCabinet::BDB' }, 'foo.tcb',
   TokyoCabinet::BDB::OWRITER | TokyoCabinet::BDB::OCREAT
      or die "open error: $!";

# on-memory hash database

tie my %h5, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, '*';
tie my %h6, 'MCE::Shared', { module => 'TokyoCabinet::ADB' }, '*';

# on-memory tree database

tie my %h7, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, '%#pccap=256m';
tie my %h8, 'MCE::Shared', { module => 'TokyoCabinet::ADB' }, '+';

πŸ—ƒοΈ Tie::Array::DBD

πŸ—ƒοΈ Tie::Hash::DBD

These two also share a construction block, so here's the whole thing: 🫢

use MCE::Shared;
use Tie::Array::DBD;
use Tie::Hash::DBD;

# A valid string is required for the DSN argument, not a DBI handle.
# Do not specify the 'str' option for Tie::(Array|Hash)::DBD.
# Instead, see encoder-decoder methods described under Common API.

use DBD::SQLite;

tie my @a1, 'MCE::Shared', { module => 'Tie::Array::DBD' },
   'dbi:SQLite:dbname=foo_a.db', {
      tbl => 't_tie_analysis',
      key => 'h_key',
      fld => 'h_value'
   };

tie my %h1, 'MCE::Shared', { module => 'Tie::Hash::DBD' },
   'dbi:SQLite:dbname=foo_h.db', {
      tbl => 't_tie_analysis',
      key => 'h_key',
      fld => 'h_value'
   };

use DBD::CSV;

tie my %h2, 'MCE::Shared', { module => 'Tie::Hash::DBD'},
   'dbi:CSV:f_dir=.;f_ext=.csv/r;csv_null=1;csv_decode_utf8=0', {
      tbl => 'mytable',
      key => 'h_key',
      fld => 'h_value'
   };

# By default, Sereal 3.015+ is used for serialization if available.
# This overrides serialization from Sereal-or-Storable to JSON::XS.

use JSON::XS ();

tied(%h2)->encoder( \&JSON::XS::encode_json );
tied(%h2)->decoder( \&JSON::XS::decode_json );

my @pairs = ( key1 => 'val1', key2 => 'val2' );
my @list  = ( 1, 2, 3, 4 );

$h2{'foo'} = 'plain value';
$h2{'bar'} = { @pairs };
$h2{'baz'} = [ @list ];

πŸ’Ύ DBM SHARING (CONT) πŸ’Ύ

Real talk: DB cursors, filters, and duplicate keys are not supported β€” just plain array and hash functionality, bestie. 🚫

The OO interface provides better performance when needed. Use iterator or next for iterating over the elements. πŸ”₯

use MCE::Hobo;
use MCE::Shared;
use Fcntl;
use DB_File;

unlink 'foo_a';

my $ob = tie my %h1, 'MCE::Shared', { module => 'DB_File' },
   'foo_a', O_CREAT|O_RDWR, 0640, $DB_HASH or die "open error: $!";

$h1{key} = 'value';
my $val = $h1{key};

while ( my ($k, $v) = each %h1 ) {
   print "1: $k => $v\n";
}

# object oriented fashion, faster

tied(%h1)->STORE( key1 => 'value1' );
my $val1 = tied(%h1)->FETCH('key1');

$ob->STORE( key2 => 'value2' );
my $val2 = $ob->FETCH('key2');

# non-parallel iteration

my $iter = $ob->iterator;
while ( my ($k, $v) = $iter->() ) {
   print "2: $k => $v\n";
}

# parallel iteration

sub task {
   while ( my ($k, $v) = $ob->next ) {
      print "[$$] $k => $v\n";
      sleep 1;
   }
}

MCE::Hobo->create(\&task) for 1 .. 3;
MCE::Hobo->waitall;

$ob->rewind;

# undef $ob and $iter before %h1 when destroying manually

undef $ob;
undef $iter;

untie %h1;

See also Tie::File Demonstration, at the end of the documentation. πŸŽ€

✨ PDL SHARING ✨

Okay bestie, this is the part where MCE::Shared gets ✨mathy✨. These are all the sugar-syntax constructors for making PDLs under the shared-manager process:

  • MCE::Shared->pdl_sbyte
  • MCE::Shared->pdl_byte
  • MCE::Shared->pdl_short
  • MCE::Shared->pdl_ushort
  • MCE::Shared->pdl_long
  • MCE::Shared->pdl_ulong
  • MCE::Shared->pdl_indx
  • MCE::Shared->pdl_longlong
  • MCE::Shared->pdl_ulonglong
  • MCE::Shared->pdl_float
  • MCE::Shared->pdl_double
  • MCE::Shared->pdl_ldouble
  • MCE::Shared->pdl_sequence
  • MCE::Shared->pdl_zeroes
  • MCE::Shared->pdl_zeros
  • MCE::Shared->pdl_ones
  • MCE::Shared->pdl_random
  • MCE::Shared->pdl_grandom
  • MCE::Shared->pdl

Basically it's sugar syntax so your PDL construction happens under the shared-manager process. But like, heads up: these helper routines only show up if PDL is loaded before MCE::Shared. That order matters, no cap. 🫢

use PDL;
use MCE::Shared;

# This makes an extra copy, transfer, including destruction.
my $ob1 = MCE::Shared->share( zeroes( 256, 256 ) );

# Do this instead to not involve an extra copy.
my $ob1 = MCE::Shared->pdl_zeroes( 256, 256 );

See the difference? First one is giving extra-copy energy. Second one is the slay option β€” no extra copy involved. πŸ’…


Below is a parallel version for a demonstration on PerlMonks. Literally iconic:

# https://www.perlmonks.org/?node_id=1214227 (by vr)

use strict;
use warnings;
use feature 'say';

use PDL;  # must load PDL before MCE::Shared

use MCE;
use MCE::Shared;
use Time::HiRes 'time';

srand( 123 );

my $time = time;

my $n = 30000;      # input sample size
my $m = 10000;      # number of bootstrap repeats
my $r = $n;         # re-sample size

# On Windows, the non-shared piddle ($x) is unblessed in threads.
# Therefore, constructing the piddle inside the worker.
# UNIX platforms benefit from copy-on-write. Thus, one copy.

my $x   = ( $^O eq 'MSWin32' ) ? undef : random( $n );
my $avg = MCE::Shared->pdl_zeroes( $m );

MCE->new(
   max_workers => 4,
   sequence    => [ 0, $m - 1 ],
   chunk_size  => 1,
   user_begin  => sub {
      $x = random( $n ) unless ( defined $x );
   },
   user_func   => sub {
      my $idx  = random $r;
      $idx    *= $n;
      # $avg is a shared piddle which resides inside the shared-
      # manager process or thread. The piddle is accessible via the
      # OO interface only.
      $avg->set( $_, $x->index( $idx )->avg );
   }
)->run;

# MCE sets the seed of the base generator uniquely between workers.
# Unfortunately, it requires running with one worker for predictable
# results (i.e. no guarantee in the order which worker computes the
# next input chunk).

say $avg->pctover( pdl 0.05, 0.95 );
say time - $time, ' seconds';

__END__

# Output

[0.49387106  0.4993768]
1.09556317329407 seconds

Look at that output bestie, [0.49387106 0.4993768] in 1.09556317329407 seconds. Numbers said πŸ’… periodt.


πŸ¦‹ ins_inplace πŸ¦‹

The ins_inplace method applies to shared PDL objects. It's got three forms for writing elements back to the PDL object that lives under the shared-manager process. Pick your fighter:

# --- action taken by the shared-manager process
# ins_inplace(  1 arg  ):  ins( inplace( $this ), $what, 0, 0 );
# ins_inplace(  2 args ):  $this->slice( $arg1 ) .= $arg2;
# ins_inplace( >2 args ):  ins( inplace( $this ), $what, @coords );

# --- use case
$o->ins_inplace( $result );                    #  1 arg
$o->ins_inplace( ":,$start:$stop", $result );  #  2 args
$o->ins_inplace( $result, 0, $seq_n );         # >2 args
Real talk: operations like + 5 will not work on shared PDL objects. At this time, the OO interface is the only mechanism for communicating with the shared piddle. So call slice, sever, or copy to fetch elements, and call ins_inplace or set (shown above) to update elements. No shortcuts, bestie, that's just how it is. 😭
use strict;
use warnings;

use PDL;  # must load PDL before MCE::Shared
use MCE::Shared;

# make a shared piddle
my $b = MCE::Shared->pdl_sequence(15,15);

# fetch, add 10 to row 2 only
my $res1 = $b->slice(":,1:1") + 10;
$b->ins_inplace($res1, 0, 1);

# fetch, add 10 to rows 4 and 5
my $res2 = $b->slice(":,3:4") + 10;
$b->ins_inplace($res2, 0, 3);

# make non-shared object (i.e. export-destroy from shared)
$b = $b->destroy;

print "$b\n";

The following provides parallel demonstrations using MCE::Flow. Obsessed with how clean this is:

use strict;
use warnings;

use PDL;  # must load PDL before MCE::Shared

use MCE::Flow;
use MCE::Shared;

# On Windows, the ($a) piddle is unblessed in worker threads.
# Therefore, constructing ($a) inside the worker versus sharing.
# UNIX platforms benefit from copy-on-write. Thus, one copy.
#
# Results are stored in the shared piddle ($b).

my $a = ( $^O eq 'MSWin32' ) ? undef : sequence(15,15);
my $b = MCE::Shared->pdl_zeroes(15,15);

MCE::Flow->init(
   user_begin => sub {
      $a = sequence(15,15) unless ( defined $a );
   }
);

# with chunking disabled

mce_flow_s {
   max_workers => 4, chunk_size => 1
},
sub {
   my $row = $_;
   my $result = $a->slice(":,$row:$row") + 5;
   $b->ins_inplace($result, 0, $row);
}, 0, 15 - 1;

# with chunking enabled

mce_flow_s {
   max_workers => 4, chunk_size => 5, bounds_only => 1
},
sub {
   my ($row1, $row2) = @{ $_ };
   my $result = $a->slice(":,$row1:$row2") + 5;
   $b->ins_inplace($result, 0, $row1);
}, 0, 15 - 1;

# make non-shared object, export-destroy the shared object

$b = $b->destroy;

print "$b\n";

See also, PDL::ParallelCPU and PDL::Parallel::threads. Go read those too, iykyk πŸ’œ

🌈 COMMON API 🌈

okay bestie, this is the shared method buffet πŸ’… β€” every shared object gets these, and they are lowkey iconic. no cap, the details matter here, so keep your eyes on the code blocks 🫢.

✨ blessed ✨

this one gives you the real "blessed" name, straight from the shared-manager process. it's giving "who am i, actually?" energy πŸ’–.

use MCE::Shared;
use Scalar::Util qw(blessed);

my $oh1 = MCE::Shared->share({ module => 'MCE::Shared::Ordhash' });
my $oh2 = MCE::Shared->share({ module => 'Hash::Ordered'        });

print blessed($oh1), "\n";    # MCE::Shared::Object
print blessed($oh2), "\n";    # MCE::Shared::Object

print $oh1->blessed(), "\n";  # MCE::Shared::Ordhash
print $oh2->blessed(), "\n";  # Hash::Ordered

πŸ’€ destroy ( { unbless => 1 } ) / destroy πŸ’€

so destroy can export first if you ask it to, but either way it fully destroys the shared object from the shared-manager process. the unbless option gets passed along to export πŸŽ€.

my $exported_ob = $shared_ob->destroy();

$shared_ob;     # becomes undef

πŸ”’ lock / unlock πŸ”“

since 1.841, shared objects have a built-in MCE::Mutex object for locking. fancy, right? πŸ’…

use MCE::Shared;

tie my @shared_array, 'MCE::Shared', { module => 'MCE::Shared::Array' }, 0;

tied(@shared_array)->lock;
$shared_array[0] += 1;
tied(@shared_array)->unlock;

print $shared_array[0], "\n";    # 1

usually you do not need locking when you're using the OO interface. but bestie, when a FETCH and a STORE are involved together, exclusive access is necessary β€” don't skip it πŸ™ˆ.

my $shared_total = MCE::Shared->scalar(2);

$shared_total->lock;
my $val = $shared_total->get;
$shared_total->set( $val * 2 );
$shared_total->unlock;

print $shared_total->get, "\n";  # 4

🧚 encoder ( CODE ) / decoder ( CODE ) 🧚

these two override the freeze/thaw routines. they apply to STORE and FETCH only, especially for TIE'd objects. internally, they get called for shared DB objects πŸ”₯.

current API available since 1.827.

use MCE::Shared;
use BerkeleyDB;
use DB_File;

my $file1 = 'file1.db';
my $file2 = 'file2.db';

tie my @db1, 'MCE::Shared', { module => 'DB_File' }, $file1,
   O_RDWR|O_CREAT, 0640 or die "open error '$file1': $!";

tie my %db2, 'MCE::Shared', { module => 'BerkeleyDB::Hash' },
   -Filename => $file2, -Flags => DB_CREATE
   or die "open error '$file2': $!";

# Called automatically by MCE::Shared for DB files.
# tied(@db1)->encoder( MCE::Shared::Server::_get_freeze );
# tied(@db1)->decoder( MCE::Shared::Server::_get_thaw );
# tied(%db2)->encoder( MCE::Shared::Server::_get_freeze );
# tied(%db2)->decoder( MCE::Shared::Server::_get_thaw );
# et cetera.

$db1[0] = 'foo';   # store plain and complex structure
$db1[1] = { key => 'value' };
$db1[2] = [ 'complex' ];

$db2{key} = 'foo'; # ditto, plain and complex structure
$db2{sun} = [ 'complex' ];

🎁 export ( { unbless => 1 }, keys ) / export 🎁

export turns the shared object into a non-shared object. you literally have to export the shared object when you pass it into any dump routine β€” otherwise all you're gonna see is the "shared_id value" and "blessed name" 😭. the unbless option unblesses any shared Array, Hash, and Scalar object into a non-blessed array, hash, and scalar respectively ✨.

use MCE::Shared;
use MCE::Shared::Ordhash;

sub _dump {
   require Data::Dumper unless $INC{'Data/Dumper.pm'};
   no warnings 'once';

   local $Data::Dumper::Varname  = 'VAR';
   local $Data::Dumper::Deepcopy = 1;
   local $Data::Dumper::Indent   = 1;
   local $Data::Dumper::Purity   = 1;
   local $Data::Dumper::Sortkeys = 0;
   local $Data::Dumper::Terse    = 0;

   print Data::Dumper::Dumper($_[0]) . "\n";
}

my $oh1 = MCE::Shared->share({ module => 'MCE::Shared::Ordhash' });
my $oh2 = MCE::Shared->ordhash();  # same thing

_dump($oh1);
   # bless( [ 1, 'MCE::Shared::Ordhash' ], 'MCE::Shared::Object' )

_dump($oh2);
   # bless( [ 2, 'MCE::Shared::Ordhash' ], 'MCE::Shared::Object' )

_dump( $oh1->export );  # dumps object structure and content
_dump( $oh2->export );  # ditto

export can optionally take a list of indices/keys for what to export. this applies to shared array, hash, and ordhash πŸ‘‘.

use MCE::Shared;

# shared hash
my $h1 = MCE::Shared->hash(
   qw/ I Heard The Bluebirds Sing by Marty Robbins /
     # k v     k   v         k    v  k     v
);

# non-shared hash
my $h2 = $h1->export( qw/ I The / );

_dump($h2);

__END__

# Output

$VAR1 = bless( {
  'I' => 'Heard',
  'The' => 'Bluebirds'
}, 'MCE::Shared::Hash' );

if you specify the unbless option, you get a non-blessed data structure instead. the unbless option applies to shared MCE::Shared::{ Array, Hash, and Scalar } objects πŸ’–.

my $h2 = $h1->export( { unbless => 1 }, qw/ I The / );
my $h3 = $h1->export( { unbless => 1 } );

_dump($h2);
_dump($h3);

__END__

# Output

$VAR1 = {
  'The' => 'Bluebirds',
  'I' => 'Heard'
};

$VAR1 = {
  'Marty' => 'Robbins',
  'Sing' => 'by',
  'The' => 'Bluebirds',
  'I' => 'Heard'
};

⏭️ next ⏭️

the next method gives you parallel iteration between workers for shared "array", "hash", "ordhash", and "sequence". in list context it returns the next key-value pair, or the beg-end pair for sequence. in scalar context it returns the next item. after the iteration is done, you get undef 🫢.

internally, the list of keys to return is set when the closure is constructed. later keys added to the shared array or hash are not included. and if a key gets deleted, the undef value is returned for it 😭.

this example iterates through a shared array in parallel:

use MCE::Hobo;
use MCE::Shared;

my $ar = MCE::Shared->array( 'a' .. 'j' );

sub demo1 {
   my ( $wid ) = @_;
   while ( my ( $index, $value ) = $ar->next ) {
      print "$wid: [ $index ] $value\n";
      sleep 1;
   }
}

sub demo2 {
   my ( $wid ) = @_;
   while ( defined ( my $value = $ar->next ) ) {
      print "$wid: $value\n";
      sleep 1;
   }
}

$ar->rewind();

MCE::Hobo->new( \&demo1, $_ ) for 1 .. 3;
MCE::Hobo->waitall(), print "\n";

$ar->rewind();

MCE::Hobo->new( \&demo2, $_ ) for 1 .. 3;
MCE::Hobo->waitall(), print "\n";

__END__

# Output

1: [ 0 ] a
2: [ 1 ] b
3: [ 2 ] c
1: [ 3 ] d
2: [ 5 ] f
3: [ 4 ] e
2: [ 8 ] i
3: [ 6 ] g
1: [ 7 ] h
2: [ 9 ] j

1: a
2: b
3: c
2: e
3: f
1: d
3: g
1: i
2: h
1: j

the form is similar for "sequence". for large sequences, the bounds_only option is recommended β€” also specify chunk_size accordingly. this reduces the amount of traffic to and from the shared-manager process 🌸.

use MCE::Hobo;
use MCE::Shared;

my $N   = shift || 4_000_000;
my $pi  = MCE::Shared->scalar( 0.0 );

my $seq = MCE::Shared->sequence(
   { chunk_size => 200_000, bounds_only => 1 }, 0, $N - 1
);

sub compute_pi {
   my ( $wid ) = @_;

   # Optionally, also receive the chunk_id value
   # while ( my ( $beg, $end, $chunk_id ) = $seq->next ) { ... }

   while ( my ( $beg, $end ) = $seq->next ) {
      my ( $_pi, $t ) = ( 0.0 );
      for my $i ( $beg .. $end ) {
         $t = ( $i + 0.5 ) / $N;
         $_pi += 4.0 / ( 1.0 + $t * $t );
      }
      $pi->incrby( $_pi );
   }

   return;
}

MCE::Hobo->create( \&compute_pi, $_ ) for ( 1 .. 8 );

# ... do other stuff ...

MCE::Hobo->waitall();

printf "pi = %0.13f\n", $pi->get / $N;

__END__

# Output

3.1415926535898

βͺ rewind βͺ

rewind ( index, [, index, ... ] )
rewind ( key, [, key, ... ] )
rewind ( "query string" )
rewind ( )

when you give it no arguments, rewind rewinds the parallel iterator for MCE::Shared::Array, MCE::Shared::Hash, or MCE::Shared::Ordhash. otherwise it resets the iterator with the criteria you gave it. the syntax for "query string" is described in the shared module πŸ’œ.

# array
$ar->rewind;

$ar->rewind( 0, 1 );
$ar->rewind( "val eq some_value" );
$ar->rewind( "key >= 50 :AND val =~ /sun|moon|air|wind/" );
$ar->rewind( "val eq sun :OR val eq moon :OR val eq foo" );
$ar->rewind( "key =~ /$pattern/" );

while ( my ( $index, $value ) = $ar->next ) {
   ...
}

# hash, ordhash
$oh->rewind;

$oh->rewind( "key1", "key2" );
$oh->rewind( "val eq some_value" );
$oh->rewind( "key eq some_key :AND val =~ /sun|moon|air|wind/" );
$oh->rewind( "val eq sun :OR val eq moon :OR val eq foo" );
$oh->rewind( "key =~ /$pattern/" );

while ( my ( $key, $value ) = $oh->next ) {
   ...
}
rewind ( { options }, begin, end [, step, format ] )
rewind ( begin, end [, step, format ] )
rewind ( )

for MCE::Shared::Sequence, no arguments means rewind that parallel iterator too. otherwise, reset it with the criteria you pass in ✨.

# sequence
$seq->rewind;

$seq->rewind( { chunk_size => 10, bounds_only => 1 }, 1, 100 );

while ( my ( $beg, $end ) = $seq->next ) {
   for my $i ( $beg .. $end ) {
      ...
   }
}

$seq->rewind( 1, 100 );

while ( defined ( my $num = $seq->next ) ) {
   ...
}

πŸ“¦ store ( key, value ) πŸ“¦

deeply sharing a non-blessed structure recursively is possible with store, which is an alias to STORE πŸŽ€. yes bestie, auto-share deeply and live your life.

use MCE::Shared;

my $h1 = MCE::Shared->hash();
my $h2 = MCE::Shared->hash();

# auto-shares deeply
$h1->store('key', [ 0, 2, 5, { 'foo' => 'bar' } ]);
$h2->{key}[3]{foo} = 'baz';    # via auto-vivification

my $v1 = $h1->get('key')->get(3)->get('foo');  # bar
my $v2 = $h2->get('key')->get(3)->get('foo');  # baz
my $v3 = $h2->{key}[3]{foo};                   # baz

πŸ–₯️ SERVER API ✨

okay so these are the class methods that keep the whole shared-manager thing running behind the scenes, and honestly they're giving backstage-pass energy πŸ‘‘

init

so this one gets called by each MCE and Hobo worker automatically after spawning β€” you don't have to do anything, it's just doing its thing πŸ’… the effect is extra parallelism and decreased latency during inter-process communication to the shared-manager process. the optional ID (an integer) gets modded internally in a round-robin fashion, cute right?

MCE::Shared->init();
MCE::Shared->init( ID );

pid

returns the process ID of the shared-manager process 🫢 this class method was added in 1.849 for stopping all workers immediately when exiting a Graphics::Framebuffer application. it returns an undefined value if the shared-manager is not running. not useful otherwise if running threads (i.e. same PID) β€” like, don't come for it, it's just doing its job πŸ™ˆ

MCE::Shared->pid();

$SIG{INT} = $SIG{HUP} = $SIG{TERM} = sub {
   # Signal workers and the shared manager all at once
   CORE::kill('KILL', MCE::Hobo->list_pids(), MCE::Shared->pid());
   exec('reset');
};

start

starts the shared-manager process πŸ”₯ this is done automatically unless Perl lacks IO::FDPass, needed to share "condvar" and "queue" while the shared-manager is running.

MCE::Shared->start();

stop

stops the shared-manager process, wiping all shared data content 🧹 this is called by the "END" block automatically when the script terminates. but lowkey β€” do stop explicitly to reap the shared-manager process before exec'ing. no cap, it matters.

MCE::Shared->stop();

exec('command');

πŸ”’ LOCKING πŸ”’

application-level advisory locking is possible with MCE::Mutex πŸ’– watch the whole thing:

use MCE::Hobo;
use MCE::Mutex;
use MCE::Shared;

my $mutex = MCE::Mutex->new();

tie my $cntr, 'MCE::Shared', 0;

sub work {
   for ( 1 .. 1000 ) {
      $mutex->lock;

      # Incrementing involves 2 IPC ops ( FETCH and STORE ).
      # Thus, locking is required.
      $cntr++;

      $mutex->unlock;
   }
}

MCE::Hobo->create('work') for ( 1 .. 8 );
MCE::Hobo->waitall;

print $cntr, "\n"; # 8000

locking is available for shared objects via "lock" and "unlock" methods since 1.841 ⭐ previously, for "condvar" only.

use MCE::Hobo;
use MCE::Shared;

tie my $cntr, 'MCE::Shared', 0;

sub work {
   for ( 1 .. 1000 ) {
      tied($cntr)->lock;

      # Incrementing involves 2 IPC ops ( FETCH and STORE ).
      # Thus, locking is required.
      $cntr++;

      tied($cntr)->unlock;
   }
}

MCE::Hobo->create('work') for ( 1 .. 8 );
MCE::Hobo->waitall;

print $cntr, "\n"; # 8000

typically, locking is not necessary using the OO interface πŸ‘€ the reason is that MCE::Shared is implemented using a single-point of entry for commands sent to the shared-manager process. furthermore, the shared classes include sugar methods for combining set and get in a single operation. slay.

use MCE::Hobo;
use MCE::Shared;

my $cntr = MCE::Shared->scalar( 0 );

sub work {
   for ( 1 .. 1000 ) {
      # The next statement increments the value without having
      # to call set and get explicitly.
      $cntr->incr;
   }
}

MCE::Hobo->create('work') for ( 1 .. 8 );
MCE::Hobo->waitall;

print $cntr->get, "\n"; # 8000

another possibility when running threads is locking via threads::shared 🧡

use threads;
use threads::shared;

use MCE::Flow;
use MCE::Shared;

my $mutex : shared;

tie my $cntr, 'MCE::Shared', 0;

sub work {
   for ( 1 .. 1000 ) {
      lock $mutex;

      # the next statement involves 2 IPC ops ( get and set )
      # thus, locking is required
      $cntr++;
   }
}

MCE::Flow->run( { max_workers => 8 }, \&work );
MCE::Flow->finish;

print $cntr, "\n"; # 8000

of the three demonstrations, the OO interface yields the best performance πŸ‘‘ this is from the lack of locking at the application level. the results were obtained from a MacBook Pro (Haswell) running at 2.6 GHz, 1600 MHz RAM. bestie, the receipts:

CentOS 7.2 VM

   -- Perl v5.16.3
   MCE::Mutex .... : 0.528 secs.
   OO Interface .. : 0.062 secs.
   threads::shared : 0.545 secs.

FreeBSD 10.0 VM

   -- Perl v5.16.3
   MCE::Mutex .... : 0.367 secs.
   OO Interface .. : 0.083 secs.
   threads::shared : 0.593 secs.

Mac OS X 10.11.6 ( Host OS )

   -- Perl v5.18.2
   MCE::Mutex .... : 0.397 secs.
   OO Interface .. : 0.070 secs.
   threads::shared : 0.463 secs.

Solaris 11.2 VM

   -- Perl v5.12.5 installed with the OS
   MCE::Mutex .... : 0.895 secs.
   OO Interface .. : 0.099 secs.
   threads::shared :              Perl not built to support threads

   -- Perl v5.22.2 built with threads support
   MCE::Mutex .... : 0.788 secs.
   OO Interface .. : 0.086 secs.
   threads::shared : 0.895 secs.

Windows 7 VM

   -- Perl v5.22.2
   MCE::Mutex .... : 1.045 secs.
   OO Interface .. : 0.312 secs.
   threads::shared : 1.061 secs.

beginning with MCE::Shared 1.809, the "pipeline" method provides another way πŸŽ€ included in "Array", "Cache", "Hash", "Minidb", and "Ordhash", it 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. iconic honestly.

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.

use MCE::Mutex;
use MCE::Shared;

my $mutex = MCE::Mutex->new();
my $oh = MCE::Shared->ordhash();
my @vals;

# mutex locking

$mutex->lock;
$oh->set( foo => "a_a" );
$oh->set( bar => "b_b" );
$oh->set( baz => "c_c" );
@vals = $oh->mget( qw/ foo bar baz / );
$mutex->unlock;

# pipeline, same thing done atomically

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

# ( "a_a", "b_b", "c_c" )

there's also "pipeline_ex", same as "pipeline", but returns data for every command in the pipeline πŸ’«

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

# ( "a_a", "b_b", "c_c" )

🐍 PYTHON DEMONSTRATION 🐍

sharing a Python class is possible, starting with the 1.827 release πŸ¦‹ the construction is simply calling share with the module option. methods are accessible via the OO interface. yes bestie, Perl and Python are holding hands, it's giving crossover episode πŸ’œ

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Python class.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

package My::Class;

use strict;
use warnings;

use Inline::Python qw( py_eval py_bind_class );

py_eval ( <<'END_OF_PYTHON_CLASS' );

class MyClass:
    def __init__(self):
        self.data = [0,0]

    def set (self, key, value):
        self.data[key] = value

    def get (self, key):
        try: return self.data[key]
        except KeyError: return None

    def incr (self, key):
        try: self.data[key] = self.data[key] + 1
        except KeyError: self.data[key] = 1

END_OF_PYTHON_CLASS

# Register methods for best performance.

py_bind_class(
    'My::Class', '__main__', 'MyClass',
    'set', 'get', 'incr'
);

1;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Share Python class. Requires MCE::Shared 1.827 or later.
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

use strict;
use warnings;

use MCE::Hobo;
use MCE::Shared;

my $py1 = MCE::Shared->share({ module => 'My::Class' });
my $py2 = MCE::Shared->share({ module => 'My::Class' });

MCE::Shared->start;

$py1->set(0, 100);
$py2->set(1, 200);

die "Ooops" unless $py1->get(0) eq '100';
die "Ooops" unless $py2->get(1) eq '200';

sub task {
    $py1->incr(0) for 1..50000;
    $py2->incr(1) for 1..50000;
}

MCE::Hobo->create(\&task) for 1..3;
MCE::Hobo->waitall;

print $py1->get(0), "\n";  # 150100
print $py2->get(1), "\n";  # 150200

and that's the Python moment, we love a multilingual icon 🌈

πŸ’– LOGGER DEMONSTRATION πŸ’–

Okay so bestie, a lot of the time you need a bunch of workers logging at the same time. Calling localtime or gmtime for every single log entry is expensive, no cap. So this keeps using the old time-stamp value until one whole second has elapsed. Iconic efficiency.

        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        # Logger class.
        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        package My::Logger;

        use strict;
        use warnings;

        use Time::HiRes qw( time );

        # construction

        sub new {
            my ( $class, %self ) = @_;

            open $self{fh}, ">>", $self{path} or return '';
            binmode $self{fh};

            $self{stamp} = localtime;  # or gmtime
            $self{time } = time;

            bless \%self, $class;
        }

        # $ob->log("message");

        sub log {
            my ( $self, $stamp ) = ( shift );

            if ( time - $self->{time} > 1.0 ) {
                $self->{stamp} = $stamp = localtime;  # or gmtime
                $self->{time } = time;
            }
            else {
                $stamp = $self->{stamp};
            }

            print {$self->{fh}} "$stamp --- @_\n";
        }

        # $ob->autoflush(0);
        # $ob->autoflush(1);

        sub autoflush {
            my ( $self, $flag ) = @_;

            if ( defined fileno($self->{fh}) ) {
                 $flag ? select(( select($self->{fh}), $| = 1 )[0])
                       : select(( select($self->{fh}), $| = 0 )[0]);

                 return 1;
            }

            return;
        }

        # $ob->binmode($layer);
        # $ob->binmode();

        sub binmode {
            my ( $self, $layer ) = @_;

            if ( defined fileno($self->{fh}) ) {
                CORE::binmode $self->{fh}, $layer // ':raw';

                return 1;
            }

            return;
        }

        # $ob->close()

        sub close {
            my ( $self ) = @_;

            if ( defined fileno($self->{fh}) ) {
                close $self->{'fh'};
            }

            return;
        }

        # $ob->flush()

        sub flush {
            my ( $self ) = @_;

            if ( defined fileno($self->{fh}) ) {
                my $old_fh = select $self->{fh};
                my $old_af = $|; $| = 1; $| = $old_af;
                select $old_fh;

                return 1;
            }

            return;
        }

        1;
        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        # Concurrent logger demo. Requires MCE::Shared 1.827 or later.
        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        use strict;
        use warnings;

        use MCE::Hobo;
        use MCE::Shared;

        my $file = "log.txt";
        my $pid  = $$;

        my $ob = MCE::Shared->share( { module => 'My::Logger' }, path => $file )
            or die "open error '$file': $!";

        # $ob->autoflush(1);   # optional, flush writes immediately

        sub work {
            my $id = shift;
            for ( 1 .. 250_000 ) {
                $ob->log("Hello from $id: $_");
            }
        }

        MCE::Hobo->create('work', $_) for 1 .. 4;
        MCE::Hobo->waitall;

        # Threads and multi-process safety for closing the handle.

        sub CLONE { $pid = 0; }

        END { $ob->close if $ob && $pid == $$; }

🧡 TIE::FILE DEMONSTRATION 🧡

Next up: a concurrent Tie::File demonstration. Each element in the array corresponds to a record in the text file, fr fr. JSON is readable, so it seems appropiate for encoding complex objects.

        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        # Class extending Tie::File with two sugar methods.
        # Requires MCE::Shared 1.827 or later.
        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        package My::File;

        use strict;
        use warnings;

        use Tie::File;

        our @ISA = 'Tie::File';

        # $ob->append('string');

        sub append {
            my ($self, $key) = @_;
            my $val = $self->FETCH($key); $val .= $_[2];
            $self->STORE($key, $val);
            length $val;
        }

        # $ob->incr($key);

        sub incr {
            my ( $self, $key ) = @_;
            my $val = $self->FETCH($key); $val += 1;
            $self->STORE($key, $val);
            $val;
        }

        1;
        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        # The MCE::Mutex module isn't needed unless IPC involves two or
        # more trips for the underlying action.
        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        use strict;
        use warnings;

        use MCE::Hobo;
        use MCE::Mutex;
        use MCE::Shared;

        use JSON::MaybeXS;

        # Safety for data having line breaks.
        use constant EOL => "\x{0a}~\x{0a}";

        my $file  = 'file.txt';
        my $mutex = MCE::Mutex->new();
        my $pid   = $$;

        my $ob = tie my @db, 'MCE::Shared', { module => 'My::File' }, $file,
            recsep => EOL or die "open error '$file': $!";

        $ob->encoder( \&JSON::MaybeXS::encode_json );
        $ob->decoder( \&JSON::MaybeXS::decode_json );

        $db[20] = 0;  # a counter at offset 20 into the array
        $db[21] = [ qw/ foo bar / ];  # store complex structure

        sub task {
            my $id  = sprintf "%02s", shift;
            my $row = int($id) - 1;
            my $chr = sprintf "%c", 97 + $id - 1;

            # A mutex isn't necessary when storing a value.
            # Ditto for fetching a value.

            $db[$row] = "Hello from $id: ";  # 1 trip
            my $val   = length $db[$row];    # 1 trip

            # A mutex may be necessary for updates involving 2 or
            # more trips (FETCH and STORE) during IPC, from and to
            # the shared-manager process, unless a unique row.

            for ( 1 .. 40 ) {
              # $db[$row] .= $id;         # 2 trips, unique row - okay
                $ob->append($row, $chr);  # 1 trip via the OO interface

              # $mu->lock;
              # $db[20] += 1;             # incrementing counter, 2 trips
              # $mu->unlock;

                $ob->incr(20);            # same thing via OO, 1 trip
            }

            my $len = length $db[$row];   # 1 trip

            printf "hobo %2d : %d\n", $id, $len;
        }

        MCE::Hobo->create('task', $_) for 1 .. 20;
        MCE::Hobo->waitall;

        printf "counter : %d\n", $db[20];
        print  $db[21]->[0], "\n";  # foo

        # Threads and multi-process safety for closing the handle.

        sub CLONE { $pid = 0; }

        END {
            if ( $pid == $$ ) {
                undef $ob;  # important, undef $ob before @db
                untie @db;  # untie @db to flush pending writes
            }
        }

πŸ› οΈ REQUIREMENTS πŸ› οΈ

MCE::Shared requires Perl 5.10.1 or later, bestie. The IO::FDPass module is highly recommended on UNIX and Windows. This module does not install it by default.


🌈 SOURCE AND FURTHER READING 🌈

The source and examples are hosted at GitHub β€” go peek, iykyk:


πŸ”Ž INDEX πŸ”Ž

MCE, MCE::Hobo


πŸ‘‘ AUTHOR πŸ‘‘

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


Copyright (C) 2016-2024 by Mario E. Roy

MCE::Shared is released under the same license as Perl.

See <https://dev.perl.org/licenses/> for more information.


Source/version + date check, periodt: perl v5.40.0, 2024-09-10, MCE::Shared(3) β€” that's the footer energy. Slay and bye, bestie πŸ’–πŸ«ΆπŸ’…

πŸ“¦ where this page comes from