1MCE::Shared(3) User Contributed Perl Documentation MCE::Shared(3)
2
6 MCE::Shared - MCE extension for sharing data supporting threads and
7 processes
8
10 This document describes MCE::Shared version 1.880
11
13 # OO construction.
14 use MCE::Shared;
16 my $ar = MCE::Shared->array( @list );
18 my $ca = MCE::Shared->cache( max_keys => 500, max_age => 60 );
19 my $cv = MCE::Shared->condvar( 0 );
20 my $fh = MCE::Shared->handle( '>>', \*STDOUT ) or die "$!";
21 my $ha = MCE::Shared->hash( @pairs );
22 my $oh = MCE::Shared->ordhash( @pairs );
23 my $db = MCE::Shared->minidb();
24 my $qu = MCE::Shared->queue( await => 1, fast => 0 );
25 my $va = MCE::Shared->scalar( $value );
26 my $se = MCE::Shared->sequence( $begin, $end, $step, $fmt );
27 my $ob = MCE::Shared->share( $blessed_object );
28 # Mutex locking is supported for all shared objects since 1.841.
30 # Previously only shared C<condvar>s allowed locking.
31 $ar->lock;
33 $ar->unlock;
34 ...
35 $ob->lock;
36 $ob->unlock;
37 # The Perl-like mce_open function is available since 1.002.
39 mce_open my $fh, ">>", "/foo/bar.log" or die "open error: $!";
41 # Tie construction. The module API option is available since 1.825.
43 use v5.10;
45 use MCE::Flow;
46 use MCE::Shared;
47 my %args = ( max_keys => 500, max_age => 60 );
49 my @pairs = ( foo => 'bar', woo => 'baz' );
50 my @list = ( 'a' .. 'z' );
51 tie my $va1, 'MCE::Shared', { module => 'MCE::Shared::Scalar' }, 0;
53 tie my @ar1, 'MCE::Shared', { module => 'MCE::Shared::Array' }, @list;
54 tie my %ca1, 'MCE::Shared', { module => 'MCE::Shared::Cache' }, %args;
55 tie my %ha1, 'MCE::Shared', { module => 'MCE::Shared::Hash' }, @pairs;
56 tie my %oh1, 'MCE::Shared', { module => 'MCE::Shared::Ordhash' }, @pairs;
57 tie my %oh2, 'MCE::Shared', { module => 'Hash::Ordered' }, @pairs;
58 tie my %oh3, 'MCE::Shared', { module => 'Tie::IxHash' }, @pairs;
59 tie my $cy1, 'MCE::Shared', { module => 'Tie::Cycle' }, [ 1 .. 8 ];
60 tie my $va2, 'MCE::Shared', { module => 'Tie::StdScalar' }, 'hello';
61 tie my @ar3, 'MCE::Shared', { module => 'Tie::StdArray' }, @list;
62 tie my %ha2, 'MCE::Shared', { module => 'Tie::StdHash' }, @pairs;
63 tie my %ha3, 'MCE::Shared', { module => 'Tie::ExtraHash' }, @pairs;
64 tie my $cnt, 'MCE::Shared', 0; # default MCE::Shared::Scalar
66 tie my @foo, 'MCE::Shared'; # default MCE::Shared::Array
67 tie my %bar, 'MCE::Shared'; # default MCE::Shared::Hash
68 tie my @ary, 'MCE::Shared', qw( a list of values );
70 tie my %ha, 'MCE::Shared', key1 => 'val1', key2 => 'val2';
71 tie my %ca, 'MCE::Shared', { max_keys => 500, max_age => 60 };
72 tie my %oh, 'MCE::Shared', { ordered => 1 }, key1 => 'value';
73 # Mutex locking is supported for all shared objects since 1.841.
75 tied($va1)->lock;
77 tied($va1)->unlock;
78 ...
79 tied(%bar)->lock;
80 tied(%bar)->unlock;
81 # Demonstration.
83 my $mutex = MCE::Mutex->new;
85 mce_flow {
87 max_workers => 4
88 },
89 sub {
90 my ( $mce ) = @_;
91 my ( $pid, $wid ) = ( MCE->pid, MCE->wid );
92 # Locking is necessary when multiple workers update the same
94 # element. The reason is that it may involve 2 trips to the
95 # shared-manager process: fetch and store in this case.
96 $mutex->enter( sub { $cnt += 1 } );
98 # Otherwise, locking is optional for unique elements.
100 $foo[ $wid - 1 ] = $pid;
102 $bar{ $pid } = $wid;
103 # From 1.841 onwards, all shared objects include mutex locking
105 # to not need to construct MCE::Mutex separately.
106 tied($va1)->lock;
108 $va1 += 1;
109 tied($va1)->unlock;
110 return;
112 };
113 say "scalar : $cnt";
115 say "scalar : $va1";
116 say " array : $_" for (@foo);
117 say " hash : $_ => $bar{$_}" for (sort keys %bar);
118 __END__
120 # Output
122 scalar : 4
124 scalar : 4
125 array : 37847
126 array : 37848
127 array : 37849
128 array : 37850
129 hash : 37847 => 1
130 hash : 37848 => 2
131 hash : 37849 => 3
132 hash : 37850 => 4
133
135 This module provides data sharing capabilities for MCE supporting
136 threads and processes. MCE::Hobo provides threads-like parallelization
137 for running code asynchronously.
138
140 MCE::Shared enables extra functionality on systems with IO::FDPass
141 installed. Without it, MCE::Shared is unable to send file descriptors
142 to the shared-manager process. The use applies to Condvar, Queue, and
143 Handle (mce_open). IO::FDpass isn't used for anything else.
144 use MCE::Shared;
146 # One may want to start the shared-manager early.
148 MCE::Shared->start();
150 # Typically, the shared-manager is started automatically when
152 # constructing a shared object.
153 my $ca = MCE::Shared->cache( max_keys => 500 );
155 # IO::FDPass is necessary for constructing a shared condvar or queue
157 # while the manager is running in order to send file descriptors
158 # associated with the object.
159 # Workers block using a socket handle for ->wait and ->timedwait.
161 my $cv = MCE::Shared->condvar();
163 # Workers block using a socket handle for ->dequeue and ->await.
165 my $q1 = MCE::Shared->queue();
167 my $q2 = MCE::Shared->queue( await => 1 );
168 For platforms where IO::FDPass isn't possible (e.g. Cygwin), construct
170 "condvar" and "queue" before other classes. The shared-manager process
171 will be delayed until sharing other classes (e.g. Array, Hash) or
172 starting explicitly.
173 use MCE::Shared;
175 my $has_IO_FDPass = $INC{'IO/FDPass.pm'} ? 1 : 0;
177 my $cv = MCE::Shared->condvar( 0 );
179 my $que = MCE::Shared->queue( fast => 1 );
180 MCE::Shared->start() unless $has_IO_FDPass;
182 my $ha = MCE::Shared->hash(); # started implicitly
184 Note that MCE starts the shared-manager, prior to spawning workers, if
186 not yet started. Ditto for MCE::Hobo.
187 Regarding mce_open, "IO::FDPass" is needed for constructing a shared-
189 handle from a non-shared handle not yet available inside the shared-
190 manager process. The workaround is to have the non-shared handle made
191 before the shared-manager is started. Passing a file by reference is
192 fine for the three STD* handles.
193 # The shared-manager knows of \*STDIN, \*STDOUT, \*STDERR.
195 mce_open my $shared_in, "<", \*STDIN; # ok
197 mce_open my $shared_out, ">>", \*STDOUT; # ok
198 mce_open my $shared_err, ">>", \*STDERR; # ok
199 mce_open my $shared_fh1, "<", "/path/to/sequence.fasta"; # ok
200 mce_open my $shared_fh2, ">>", "/path/to/results.log"; # ok
201 mce_open my $shared_fh, ">>", \*NON_SHARED_FH; # requires IO::FDPass
203 The IO::FDPass module is known to work reliably on most platforms.
205 Install 1.1 or later to rid of limitations described above.
206 perl -MIO::FDPass -le "print 'Cheers! Perl has IO::FDPass.'"
208
210 MCE::Shared->array MCE::Shared::Array
211 MCE::Shared->cache MCE::Shared::Cache
212 MCE::Shared->condvar MCE::Shared::Condvar
213 MCE::Shared->handle MCE::Shared::Handle
214 MCE::Shared->hash MCE::Shared::Hash
215 MCE::Shared->minidb MCE::Shared::Minidb
216 MCE::Shared->ordhash MCE::Shared::Ordhash
217 MCE::Shared->queue MCE::Shared::Queue
218 MCE::Shared->scalar MCE::Shared::Scalar
219 MCE::Shared->sequence MCE::Shared::Sequence
220 Below, synopsis for sharing classes included with MCE::Shared.
222 use MCE::Shared;
224 # short form
226 $ar = MCE::Shared->array( @list );
228 $ca = MCE::Shared->cache( max_keys => 500, max_age => 60 );
229 $cv = MCE::Shared->condvar( 0 );
230 $fh = MCE::Shared->handle( ">>", \*STDOUT ); # see mce_open below
231 $ha = MCE::Shared->hash( @pairs );
232 $db = MCE::Shared->minidb();
233 $oh = MCE::Shared->ordhash( @pairs );
234 $qu = MCE::Shared->queue( await => 1, fast => 0 );
235 $va = MCE::Shared->scalar( $value );
236 $se = MCE::Shared->sequence( $begin, $end, $step, $fmt );
237 mce_open my $fh, ">>", \*STDOUT or die "open error: $!";
239 # long form
241 $ar = MCE::Shared->share( { module => 'MCE::Shared::Array' }, ... );
243 $ca = MCE::Shared->share( { module => 'MCE::Shared::Cache' }, ... );
244 $cv = MCE::Shared->share( { module => 'MCE::Shared::Condvar' }, ... );
245 $fh = MCE::Shared->share( { module => 'MCE::Shared::Handle' }, ... );
246 $ha = MCE::Shared->share( { module => 'MCE::Shared::Hash' }, ... );
247 $db = MCE::Shared->share( { module => 'MCE::Shared::Minidb' }, ... );
248 $oh = MCE::Shared->share( { module => 'MCE::Shared::Ordhash' }, ... );
249 $qu = MCE::Shared->share( { module => 'MCE::Shared::Queue' }, ... );
250 $va = MCE::Shared->share( { module => 'MCE::Shared::Scalar' }, ... );
251 $se = MCE::Shared->share( { module => 'MCE::Shared::Sequence' }, ... );
252 The restriction for sharing classes not included with MCE::Shared is
254 that the object must not have file-handles nor code-blocks.
255 $oh = MCE::Shared->share( { module => 'Hash::Ordered' }, ... );
257 open ( filehandle, expr )
259 open ( filehandle, mode, expr )
260 open ( filehandle, mode, reference )
261 In version 1.002 and later, constructs a new object by opening the file
263 whose filename is given by "expr", and associates it with "filehandle".
264 When omitting error checking at the application level, MCE::Shared
265 emits a message and stop if open fails.
266 See MCE::Shared::Handle for chunk IO demonstrations.
268 {
270 use MCE::Shared::Handle;
271 # "non-shared" or "local construction" for use by a single process
273 MCE::Shared::Handle->open( my $fh, "<", "file.log" ) or die "$!";
274 MCE::Shared::Handle::open my $fh, "<", "file.log" or die "$!";
275 # mce_open is an alias for MCE::Shared::Handle::open
277 mce_open my $fh, "<", "file.log" or die "$!";
278 }
279 {
281 use MCE::Shared;
282 # construction for "sharing" with other threads and processes
284 MCE::Shared->open( my $fh, "<", "file.log" ) or die "$!";
285 MCE::Shared::open my $fh, "<", "file.log" or die "$!";
286 # mce_open is an alias for MCE::Shared::open
288 mce_open my $fh, "<", "file.log" or die "$!";
289 }
290 mce_open ( filehandle, expr )
292 mce_open ( filehandle, mode, expr )
293 mce_open ( filehandle, mode, reference )
294 Native Perl-like syntax to open a shared-file for reading:
296 use MCE::Shared;
298 # mce_open is exported by MCE::Shared or MCE::Shared::Handle.
300 # It creates a shared file handle with MCE::Shared present
301 # or a non-shared handle otherwise.
302 mce_open my $fh, "< input.txt" or die "open error: $!";
304 mce_open my $fh, "<", "input.txt" or die "open error: $!";
305 mce_open my $fh, "<", \*STDIN or die "open error: $!";
306 and for writing:
308 mce_open my $fh, "> output.txt" or die "open error: $!";
310 mce_open my $fh, ">", "output.txt" or die "open error: $!";
311 mce_open my $fh, ">", \*STDOUT or die "open error: $!";
312 num_sequence
314 "num_sequence" is an alias for "sequence".
316
318 Constructing a deeply-shared object, from a non-blessed data structure,
319 is possible via the "_DEEPLY_" option. The data resides in the shared-
320 manager thread or process. To get back a non-blessed data structure,
321 specify the "unbless" option to "export". The "export" method is
322 described later under the Common API section.
323 use MCE::Hobo;
325 use MCE::Shared;
326 use Data::Dumper;
327 my @data = ('wind', 'air', [ 'a', 'b', { foo => 'bar' }, 'c' ]);
329 my $shared_data = MCE::Shared->share({_DEEPLY_ => 1}, \@data);
330 MCE::Hobo->create(sub {
332 $shared_data->[2][2]{hi} = 'there';
333 $shared_data->[2][4]{hi} = 'there';
334 })->join;
335 print $shared_data->get(2)->get(2)->get('hi'), "\n";
337 print $shared_data->[2][2]{hi}, "\n\n"; # or Perl-like behavior
338 print Dumper($shared_data->export({ unbless => 1 })), "\n";
340 __END__
342 # Output
344 there # get method(s)
346 there # dereferencing
347 $VAR1 = [
349 'wind',
350 'air',
351 [
352 'a',
353 'b',
354 {
355 'foo' => 'bar',
356 'hi' => 'there'
357 },
358 'c',
359 {
360 'hi' => 'there'
361 }
362 ]
363 ];
364 The following is a demonstration for a shared tied-hash variable.
366 Before venturing into the actual code, notice the dump function making
367 a call to "export" explicitly for objects of type
368 "MCE::Shared::Object". This is necessary in order to retrieve the data
369 from the shared-manager process.
370 use MCE::Shared;
372 sub _dump {
374 require Data::Dumper unless $INC{'Data/Dumper.pm'};
375 no warnings 'once';
376 local $Data::Dumper::Varname = 'VAR';
378 local $Data::Dumper::Deepcopy = 1;
379 local $Data::Dumper::Indent = 1;
380 local $Data::Dumper::Purity = 1;
381 local $Data::Dumper::Sortkeys = 0;
382 local $Data::Dumper::Terse = 0;
383 ( ref $_[0] eq 'MCE::Shared::Object' )
385 ? print Data::Dumper::Dumper( $_[0]->export ) . "\n"
386 : print Data::Dumper::Dumper( $_[0] ) . "\n";
387 }
388 tie my %abc, 'MCE::Shared';
390 my @parents = qw( a b c );
392 my @children = qw( 1 2 3 4 );
393 for my $parent ( @parents ) {
395 for my $child ( @children ) {
396 $abc{ $parent }{ $child } = 1;
397 }
398 }
399 _dump( tied( %abc ) );
401 __END__
403 # Output
405 $VAR1 = bless( {
407 'c' => bless( {
408 '1' => '1',
409 '4' => '1',
410 '3' => '1',
411 '2' => '1'
412 }, 'MCE::Shared::Hash' ),
413 'a' => bless( {
414 '1' => '1',
415 '4' => '1',
416 '3' => '1',
417 '2' => '1'
418 }, 'MCE::Shared::Hash' ),
419 'b' => bless( {
420 '1' => '1',
421 '4' => '1',
422 '3' => '1',
423 '2' => '1'
424 }, 'MCE::Shared::Hash' )
425 }, 'MCE::Shared::Hash' );
426 Dereferencing provides hash-like behavior for "hash" and "ordhash".
428 Array-like behavior is allowed for "array", not shown below.
429 use MCE::Shared;
431 use Data::Dumper;
432 my $abc = MCE::Shared->hash;
434 my @parents = qw( a b c );
436 my @children = qw( 1 2 3 4 );
437 for my $parent ( @parents ) {
439 for my $child ( @children ) {
440 $abc->{ $parent }{ $child } = 1;
441 }
442 }
443 print Dumper( $abc->export({ unbless => 1 }) ), "\n";
445 Each level in a deeply structure requires a separate trip to the
447 shared-manager process. The included "MCE::Shared::Minidb" module
448 provides optimized methods for working with hash of hashes "HoH" and
449 hash of arrays "HoA".
450 use MCE::Shared;
452 use Data::Dumper;
453 my $abc = MCE::Shared->minidb;
455 my @parents = qw( a b c );
457 my @children = qw( 1 2 3 4 );
458 for my $parent ( @parents ) {
460 for my $child ( @children ) {
461 $abc->hset($parent, $child, 1);
462 }
463 }
464 print Dumper( $abc->export ), "\n";
466 For further reading, see MCE::Shared::Minidb.
468
470 MCE::Shared->share
471 This class method transfers the blessed-object to the shared-manager
473 process and returns a "MCE::Shared::Object" containing the "SHARED_ID".
474 Starting with the 1.827 release, the "module" option sends parameters
475 to the shared-manager, where the object is then constructed. This is
476 useful for classes involving XS code or a file handle.
477 use MCE::Shared;
479 {
481 use Math::BigFloat try => 'GMP';
482 use Math::BigInt try => 'GMP';
483 my $bf = MCE::Shared->share({ module => 'Math::BigFloat' }, 0);
485 my $bi = MCE::Shared->share({ module => 'Math::BigInt' }, 0);
486 my $y = 1e9;
487 $bf->badd($y); # addition (add $y to shared BigFloat object)
489 $bi->badd($y); # addition (add $y to shared BigInt object)
490 }
491 {
493 use Bio::Seq;
494 use Bio::SeqIO;
495 my $seq_io = MCE::Shared->share({ module => 'Bio::SeqIO' },
497 -file => ">/path/to/fasta/file.fa",
498 -format => 'Fasta',
499 -verbose => -1,
500 );
501 my $seq_obj = Bio::Seq->new(
503 -display_id => "name", -desc => "desc", -seq => "seq",
504 -alphabet => "dna"
505 );
506 $seq_io->write_seq($seq_obj); # write to shared SeqIO handle
508 }
509 {
511 my $oh1 = MCE::Shared->share({ module => 'MCE::Shared::Ordhash' });
512 my $oh2 = MCE::Shared->ordhash(); # same thing
513 $oh1->assign( @pairs );
515 $oh2->assign( @pairs );
516 }
517 {
519 my ($ho_shared, $ho_nonshared);
520 $ho_shared = MCE::Shared->share({ module => 'Hash::Ordered' });
522 $ho_shared->push( @pairs );
523 $ho_nonshared = $ho_shared->export(); # back to non-shared
525 $ho_nonshared = $ho_shared->destroy(); # including shared destruction
526 }
527 The following provides long and short forms for constructing a shared
529 array, hash, or scalar object.
530 use MCE::Shared;
532 my $a1 = MCE::Shared->share( { module => 'MCE::Shared::Array' }, @list );
534 my $a2 = MCE::Shared->share( [ @list ] );
535 my $a3 = MCE::Shared->array( @list );
536 my $h1 = MCE::Shared->share( { module => 'MCE::Shared::Hash' }, @pairs );
538 my $h2 = MCE::Shared->share( { @pairs } );
539 my $h3 = MCE::Shared->hash( @pairs );
540 my $s1 = MCE::Shared->share( { module => 'MCE::Shared::Scalar' }, 20 );
542 my $s2 = MCE::Shared->share( \do{ my $o = 20 } );
543 my $s3 = MCE::Shared->scalar( 20 );
544 When the "module" option is given, one may optionally specify the
546 constructor function via the "new" option. This is necessary for the
547 CDB_File module, which provides two different objects. One is created
548 by new (default), and accessed by insert and finish. The other is
549 created by TIEHASH, and accessed by FETCH.
550 use MCE::Hobo;
552 use MCE::Shared;
553 # populate CDB file
555 my $cdb = MCE::Shared->share({ module => 'CDB_File' }, 't.cdb', "t.cdb.$$")
556 or die "$!\n";
557 $cdb->insert( $_ => $_ ) for ('aa'..'zz');
559 $cdb->finish;
560 # use CDB file
562 my $cdb1 = tie my %hash, 'MCE::Shared', { module => 'CDB_File' }, 't.cdb';
563 # same thing, without involving TIE and extra hash variable
565 my $cdb2 = MCE::Shared->share(
566 { module => 'CDB_File', new => 'TIEHASH' }, 't.cdb'
567 );
568 print $hash{'aa'}, "\n";
570 print $cdb1->FETCH('bb'), "\n";
571 print $cdb2->FETCH('cc'), "\n";
572 # rewind may be omitted on first use for parallel iteration
574 $cdb2->rewind;
575 for ( 1 .. 3 ) {
577 mce_async {
578 while ( my ($k,$v) = $cdb2->next ) {
579 print "[$$] $k => $v\n";
580 }
581 };
582 }
583 MCE::Hobo->waitall;
585
587 Construting a shared DBM object is possible starting with the 1.827
588 release. Supported modules are AnyDBM_File, BerkeleyDB, CDB_File,
589 DB_File, GDBM_File, NDBM_File, ODBM_File, SDBM_File, SQLite_File,
590 Tie::Array::DBD, and Tie::Hash::DBD. The list includes Tokyo Cabinet
591 <http://fallabs.com/tokyocabinet/> and Kyoto Cabinet
592 <http://fallabs.com/kyotocabinet/>. Also, see forked version by Altice
593 Labs <https://github.com/alticelabs/kyoto>. It contains an updated
594 "kyotocabinet" folder that builds successfully with recent compilers.
595 Freeze-thaw during "STORE"-"FETCH" (for complex data) is handled
597 automatically using Serial 3.015+ (if available) or Storable. Below,
598 are constructions for sharing various DBM modules. The construction for
599 "CDB_File" is given in the prior section.
600 AnyDBM_File
602 BEGIN { @AnyDBM_File::ISA = qw( DB_File GDBM_File NDBM_File ODBM_File ); }
604 use MCE::Shared;
606 use Fcntl;
607 use AnyDBM_File;
608 tie my %h1, 'MCE::Shared', { module => 'AnyDBM_File' },
610 'foo_a', O_CREAT|O_RDWR or die "open error: $!";
611 BerkeleyDB
613 use MCE::Shared;
615 use BerkeleyDB;
616 tie my %h1, 'MCE::Shared', { module => 'BerkeleyDB::Hash' },
618 -Filename => 'foo_a', -Flags => DB_CREATE
619 or die "open error: $!";
620 tie my %h2, 'MCE::Shared', { module => 'BerkeleyDB::Btree' },
622 -Filename => 'foo_b', -Flags => DB_CREATE
623 or die "open error: $!";
624 tie my @a1, 'MCE::Shared', { module => 'BerkeleyDB::Queue' },
626 -Filename => 'foo_c', -Flags => DB_CREATE
627 or die "open error: $!";
628 tie my @a2, 'MCE::Shared', { module => 'BerkeleyDB::Recno' },
630 -Filename => 'foo_d', -Flags => DB_CREATE -Len => 20
631 or die "open error: $!";
632 DB_File
634 use MCE::Shared;
636 use Fcntl;
637 use DB_File;
638 # Use pre-defined references ( $DB_HASH, $DB_BTREE, $DB_RECNO ).
640 tie my %h1, 'MCE::Shared', { module => 'DB_File' },
642 'foo_a', O_CREAT|O_RDWR, 0640, $DB_HASH or die "open error: $!";
643 tie my %h2, 'MCE::Shared', { module => 'DB_File' },
645 'foo_b', O_CREAT|O_RDWR, 0640, $DB_BTREE or die "open error: $!";
646 tie my @a1, 'MCE::Shared', { module => 'DB_File' },
648 'foo_c', O_CREAT|O_RDWR, 0640, $DB_RECNO or die "open error: $!";
649 # Changing defaults - see DB_File for valid options.
651 my $opt_h = DB_File::HASHINFO->new();
653 my $opt_b = DB_File::BTREEINFO->new();
654 my $opt_r = DB_File::RECNOINFO->new();
655 $opt_h->{'cachesize'} = 12345;
657 tie my %h3, 'MCE::Shared', { module => 'DB_File' },
659 'foo_d', O_CREAT|O_RDWR, 0640, $opt_h or die "open error: $!";
660 KyotoCabinet
662 TokyoCabinet
663 use MCE::Shared;
665 use KyotoCabinet;
666 use TokyoCabinet;
667 # file extension denotes hash database
669 tie my %h1, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, 'foo.kch',
671 KyotoCabinet::DB::OWRITER | KyotoCabinet::DB::OCREATE
672 or die "open error: $!";
673 tie my %h2, 'MCE::Shared', { module => 'TokyoCabinet::HDB' }, 'foo.tch',
675 TokyoCabinet::HDB::OWRITER | TokyoCabinet::HDB::OCREAT
676 or die "open error: $!";
677 # file extension denotes tree database
679 tie my %h3, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, 'foo.kct',
681 KyotoCabinet::DB::OWRITER | KyotoCabinet::DB::OCREATE
682 or die "open error: $!";
683 tie my %h4, 'MCE::Shared', { module => 'TokyoCabinet::BDB' }, 'foo.tcb',
685 TokyoCabinet::BDB::OWRITER | TokyoCabinet::BDB::OCREAT
686 or die "open error: $!";
687 # on-memory hash database
689 tie my %h5, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, '*';
691 tie my %h6, 'MCE::Shared', { module => 'TokyoCabinet::ADB' }, '*';
692 # on-memory tree database
694 tie my %h7, 'MCE::Shared', { module => 'KyotoCabinet::DB' }, '%#pccap=256m';
696 tie my %h8, 'MCE::Shared', { module => 'TokyoCabinet::ADB' }, '+';
697 Tie::Array::DBD
699 Tie::Hash::DBD
700 use MCE::Shared;
702 use Tie::Array::DBD;
703 use Tie::Hash::DBD;
704 # A valid string is required for the DSN argument, not a DBI handle.
706 # Do not specify the 'str' option for Tie::(Array|Hash)::DBD.
707 # Instead, see encoder-decoder methods described under Common API.
708 use DBD::SQLite;
710 tie my @a1, 'MCE::Shared', { module => 'Tie::Array::DBD' },
712 'dbi:SQLite:dbname=foo_a.db', {
713 tbl => 't_tie_analysis',
714 key => 'h_key',
715 fld => 'h_value'
716 };
717 tie my %h1, 'MCE::Shared', { module => 'Tie::Hash::DBD' },
719 'dbi:SQLite:dbname=foo_h.db', {
720 tbl => 't_tie_analysis',
721 key => 'h_key',
722 fld => 'h_value'
723 };
724 use DBD::CSV;
726 tie my %h2, 'MCE::Shared', { module => 'Tie::Hash::DBD'},
728 'dbi:CSV:f_dir=.;f_ext=.csv/r;csv_null=1;csv_decode_utf8=0', {
729 tbl => 'mytable',
730 key => 'h_key',
731 fld => 'h_value'
732 };
733 # By default, Sereal 3.015+ is used for serialization if available.
735 # This overrides serialization from Sereal-or-Storable to JSON::XS.
736 use JSON::XS ();
738 tied(%h2)->encoder( \&JSON::XS::encode_json );
740 tied(%h2)->decoder( \&JSON::XS::decode_json );
741 my @pairs = ( key1 => 'val1', key2 => 'val2' );
743 my @list = ( 1, 2, 3, 4 );
744 $h2{'foo'} = 'plain value';
746 $h2{'bar'} = { @pairs };
747 $h2{'baz'} = [ @list ];
748
750 DB cursors, filters, and duplicate keys are not supported, just plain
751 array and hash functionality. The OO interface provides better
752 performance when needed. Use "iterator" or "next" for iterating over
753 the elements.
754 use MCE::Hobo;
756 use MCE::Shared;
757 use Fcntl;
758 use DB_File;
759 unlink 'foo_a';
761 my $ob = tie my %h1, 'MCE::Shared', { module => 'DB_File' },
763 'foo_a', O_CREAT|O_RDWR, 0640, $DB_HASH or die "open error: $!";
764 $h1{key} = 'value';
766 my $val = $h1{key};
767 while ( my ($k, $v) = each %h1 ) {
769 print "1: $k => $v\n";
770 }
771 # object oriented fashion, faster
773 tied(%h1)->STORE( key1 => 'value1' );
775 my $val1 = tied(%h1)->FETCH('key1');
776 $ob->STORE( key2 => 'value2' );
778 my $val2 = $ob->FETCH('key2');
779 # non-parallel iteration
781 my $iter = $ob->iterator;
783 while ( my ($k, $v) = $iter->() ) {
784 print "2: $k => $v\n";
785 }
786 # parallel iteration
788 sub task {
790 while ( my ($k, $v) = $ob->next ) {
791 print "[$$] $k => $v\n";
792 sleep 1;
793 }
794 }
795 MCE::Hobo->create(\&task) for 1 .. 3;
797 MCE::Hobo->waitall;
798 $ob->rewind;
800 # undef $ob and $iter before %h1 when destroying manually
802 undef $ob;
804 undef $iter;
805 untie %h1;
807 See also Tie::File Demonstration, at the end of the documentation.
809
811 MCE::Shared->pdl_sbyte
812 MCE::Shared->pdl_byte
813 MCE::Shared->pdl_short
814 MCE::Shared->pdl_ushort
815 MCE::Shared->pdl_long
816 MCE::Shared->pdl_ulong
817 MCE::Shared->pdl_indx
818 MCE::Shared->pdl_longlong
819 MCE::Shared->pdl_ulonglong
820 MCE::Shared->pdl_float
821 MCE::Shared->pdl_double
822 MCE::Shared->pdl_ldouble
823 MCE::Shared->pdl_sequence
824 MCE::Shared->pdl_zeroes
825 MCE::Shared->pdl_zeros
826 MCE::Shared->pdl_ones
827 MCE::Shared->pdl_random
828 MCE::Shared->pdl_grandom
829 MCE::Shared->pdl
830 Sugar syntax for PDL construction to take place under the shared-
832 manager process. The helper routines are made available only if "PDL"
833 is loaded before "MCE::Shared".
834 use PDL;
836 use MCE::Shared;
837 # This makes an extra copy, transfer, including destruction.
839 my $ob1 = MCE::Shared->share( zeroes( 256, 256 ) );
840 # Do this instead to not involve an extra copy.
842 my $ob1 = MCE::Shared->pdl_zeroes( 256, 256 );
843 Below is a parallel version for a demonstration on PerlMonks.
845 # https://www.perlmonks.org/?node_id=1214227 (by vr)
847 use strict;
849 use warnings;
850 use feature 'say';
851 use PDL; # must load PDL before MCE::Shared
853 use MCE;
855 use MCE::Shared;
856 use Time::HiRes 'time';
857 srand( 123 );
859 my $time = time;
861 my $n = 30000; # input sample size
863 my $m = 10000; # number of bootstrap repeats
864 my $r = $n; # re-sample size
865 # On Windows, the non-shared piddle ($x) is unblessed in threads.
867 # Therefore, constructing the piddle inside the worker.
868 # UNIX platforms benefit from copy-on-write. Thus, one copy.
869 my $x = ( $^O eq 'MSWin32' ) ? undef : random( $n );
871 my $avg = MCE::Shared->pdl_zeroes( $m );
872 MCE->new(
874 max_workers => 4,
875 sequence => [ 0, $m - 1 ],
876 chunk_size => 1,
877 user_begin => sub {
878 $x = random( $n ) unless ( defined $x );
879 },
880 user_func => sub {
881 my $idx = random $r;
882 $idx *= $n;
883 # $avg is a shared piddle which resides inside the shared-
884 # manager process or thread. The piddle is accessible via the
885 # OO interface only.
886 $avg->set( $_, $x->index( $idx )->avg );
887 }
888 )->run;
889 # MCE sets the seed of the base generator uniquely between workers.
891 # Unfortunately, it requires running with one worker for predictable
892 # results (i.e. no guarantee in the order which worker computes the
893 # next input chunk).
894 say $avg->pctover( pdl 0.05, 0.95 );
896 say time - $time, ' seconds';
897 __END__
899 # Output
901 [0.49387106 0.4993768]
903 1.09556317329407 seconds
904 ins_inplace
906 The "ins_inplace" method applies to shared PDL objects. It supports
908 three forms for writing elements back to the PDL object, residing under
909 the shared-manager process.
910 # --- action taken by the shared-manager process
912 # ins_inplace( 1 arg ): ins( inplace( $this ), $what, 0, 0 );
913 # ins_inplace( 2 args ): $this->slice( $arg1 ) .= $arg2;
914 # ins_inplace( >2 args ): ins( inplace( $this ), $what, @coords );
915 # --- use case
917 $o->ins_inplace( $result ); # 1 arg
918 $o->ins_inplace( ":,$start:$stop", $result ); # 2 args
919 $o->ins_inplace( $result, 0, $seq_n ); # >2 args
920 Operations such as " + 5 " will not work on shared PDL objects. At this
922 time, the OO interface is the only mechanism for communicating with the
923 shared piddle. For example, call "slice", "sever", or "copy" to fetch
924 elements. Call "ins_inplace" or "set" (shown above) to update elements.
925 use strict;
927 use warnings;
928 use PDL; # must load PDL before MCE::Shared
930 use MCE::Shared;
931 # make a shared piddle
933 my $b = MCE::Shared->pdl_sequence(15,15);
934 # fetch, add 10 to row 2 only
936 my $res1 = $b->slice(":,1:1") + 10;
937 $b->ins_inplace($res1, 0, 1);
938 # fetch, add 10 to rows 4 and 5
940 my $res2 = $b->slice(":,3:4") + 10;
941 $b->ins_inplace($res2, 0, 3);
942 # make non-shared object (i.e. export-destroy from shared)
944 $b = $b->destroy;
945 print "$b\n";
947 The following provides parallel demonstrations using "MCE::Flow".
949 use strict;
951 use warnings;
952 use PDL; # must load PDL before MCE::Shared
954 use MCE::Flow;
956 use MCE::Shared;
957 # On Windows, the ($a) piddle is unblessed in worker threads.
959 # Therefore, constructing ($a) inside the worker versus sharing.
960 # UNIX platforms benefit from copy-on-write. Thus, one copy.
961 #
962 # Results are stored in the shared piddle ($b).
963 my $a = ( $^O eq 'MSWin32' ) ? undef : sequence(15,15);
965 my $b = MCE::Shared->pdl_zeroes(15,15);
966 MCE::Flow->init(
968 user_begin => sub {
969 $a = sequence(15,15) unless ( defined $a );
970 }
971 );
972 # with chunking disabled
974 mce_flow_s {
976 max_workers => 4, chunk_size => 1
977 },
978 sub {
979 my $row = $_;
980 my $result = $a->slice(":,$row:$row") + 5;
981 $b->ins_inplace($result, 0, $row);
982 }, 0, 15 - 1;
983 # with chunking enabled
985 mce_flow_s {
987 max_workers => 4, chunk_size => 5, bounds_only => 1
988 },
989 sub {
990 my ($row1, $row2) = @{ $_ };
991 my $result = $a->slice(":,$row1:$row2") + 5;
992 $b->ins_inplace($result, 0, $row1);
993 }, 0, 15 - 1;
994 # make non-shared object, export-destroy the shared object
996 $b = $b->destroy;
998 print "$b\n";
1000 See also, PDL::ParallelCPU and PDL::Parallel::threads.
1002
1004 blessed
1005 Returns the real "blessed" name, provided by the shared-manager
1006 process.
1007 use MCE::Shared;
1009 use Scalar::Util qw(blessed);
1010 my $oh1 = MCE::Shared->share({ module => 'MCE::Shared::Ordhash' });
1012 my $oh2 = MCE::Shared->share({ module => 'Hash::Ordered' });
1013 print blessed($oh1), "\n"; # MCE::Shared::Object
1015 print blessed($oh2), "\n"; # MCE::Shared::Object
1016 print $oh1->blessed(), "\n"; # MCE::Shared::Ordhash
1018 print $oh2->blessed(), "\n"; # Hash::Ordered
1019 destroy ( { unbless => 1 } )
1021 destroy
1022 Exports optionally, but destroys the shared object entirely from the
1023 shared-manager process. The unbless option is passed to export.
1024 my $exported_ob = $shared_ob->destroy();
1026 $shared_ob; # becomes undef
1028 lock
1030 unlock
1031 Shared objects embed a MCE::Mutex object for locking since 1.841.
1032 use MCE::Shared;
1034 tie my @shared_array, 'MCE::Shared', { module => 'MCE::Shared::Array' }, 0;
1036 tied(@shared_array)->lock;
1038 $shared_array[0] += 1;
1039 tied(@shared_array)->unlock;
1040 print $shared_array[0], "\n"; # 1
1042 Locking is not necessary typically when using the OO interface.
1044 Although, exclusive access is necessary when involving a FETCH and
1045 STORE.
1046 my $shared_total = MCE::Shared->scalar(2);
1048 $shared_total->lock;
1050 my $val = $shared_total->get;
1051 $shared_total->set( $val * 2 );
1052 $shared_total->unlock;
1053 print $shared_total->get, "\n"; # 4
1055 encoder ( CODE )
1057 decoder ( CODE )
1058 Override freeze/thaw routines. Applies to STORE and FETCH only,
1059 particularly for TIE'd objects. These are called internally for
1060 shared DB objects.
1061 Current API available since 1.827.
1063 use MCE::Shared;
1065 use BerkeleyDB;
1066 use DB_File;
1067 my $file1 = 'file1.db';
1069 my $file2 = 'file2.db';
1070 tie my @db1, 'MCE::Shared', { module => 'DB_File' }, $file1,
1072 O_RDWR|O_CREAT, 0640 or die "open error '$file1': $!";
1073 tie my %db2, 'MCE::Shared', { module => 'BerkeleyDB::Hash' },
1075 -Filename => $file2, -Flags => DB_CREATE
1076 or die "open error '$file2': $!";
1077 # Called automatically by MCE::Shared for DB files.
1079 # tied(@db1)->encoder( MCE::Shared::Server::_get_freeze );
1080 # tied(@db1)->decoder( MCE::Shared::Server::_get_thaw );
1081 # tied(%db2)->encoder( MCE::Shared::Server::_get_freeze );
1082 # tied(%db2)->decoder( MCE::Shared::Server::_get_thaw );
1083 # et cetera.
1084 $db1[0] = 'foo'; # store plain and complex structure
1086 $db1[1] = { key => 'value' };
1087 $db1[2] = [ 'complex' ];
1088 $db2{key} = 'foo'; # ditto, plain and complex structure
1090 $db2{sun} = [ 'complex' ];
1091 export ( { unbless => 1 }, keys )
1093 export
1094 Exports the shared object as a non-shared object. One must export
1095 the shared object when passing into any dump routine. Otherwise, the
1096 "shared_id value" and "blessed name" is all one will see. The
1097 unbless option unblesses any shared Array, Hash, and Scalar object
1098 to a non-blessed array, hash, and scalar respectively.
1099 use MCE::Shared;
1101 use MCE::Shared::Ordhash;
1102 sub _dump {
1104 require Data::Dumper unless $INC{'Data/Dumper.pm'};
1105 no warnings 'once';
1106 local $Data::Dumper::Varname = 'VAR';
1108 local $Data::Dumper::Deepcopy = 1;
1109 local $Data::Dumper::Indent = 1;
1110 local $Data::Dumper::Purity = 1;
1111 local $Data::Dumper::Sortkeys = 0;
1112 local $Data::Dumper::Terse = 0;
1113 print Data::Dumper::Dumper($_[0]) . "\n";
1115 }
1116 my $oh1 = MCE::Shared->share({ module => 'MCE::Shared::Ordhash' });
1118 my $oh2 = MCE::Shared->ordhash(); # same thing
1119 _dump($oh1);
1121 # bless( [ 1, 'MCE::Shared::Ordhash' ], 'MCE::Shared::Object' )
1122 _dump($oh2);
1124 # bless( [ 2, 'MCE::Shared::Ordhash' ], 'MCE::Shared::Object' )
1125 _dump( $oh1->export ); # dumps object structure and content
1127 _dump( $oh2->export ); # ditto
1128 "export" can optionally take a list of indices/keys for what to
1130 export. This applies to shared array, hash, and ordhash.
1131 use MCE::Shared;
1133 # shared hash
1135 my $h1 = MCE::Shared->hash(
1136 qw/ I Heard The Bluebirds Sing by Marty Robbins /
1137 # k v k v k v k v
1138 );
1139 # non-shared hash
1141 my $h2 = $h1->export( qw/ I The / );
1142 _dump($h2);
1144 __END__
1146 # Output
1148 $VAR1 = bless( {
1150 'I' => 'Heard',
1151 'The' => 'Bluebirds'
1152 }, 'MCE::Shared::Hash' );
1153 Specifying the unbless option exports a non-blessed data structure
1155 instead. The unbless option applies to shared MCE::Shared::{ Array,
1156 Hash, and Scalar } objects.
1157 my $h2 = $h1->export( { unbless => 1 }, qw/ I The / );
1159 my $h3 = $h1->export( { unbless => 1 } );
1160 _dump($h2);
1162 _dump($h3);
1163 __END__
1165 # Output
1167 $VAR1 = {
1169 'The' => 'Bluebirds',
1170 'I' => 'Heard'
1171 };
1172 $VAR1 = {
1174 'Marty' => 'Robbins',
1175 'Sing' => 'by',
1176 'The' => 'Bluebirds',
1177 'I' => 'Heard'
1178 };
1179 next
1181 The "next" method provides parallel iteration between workers for
1182 shared "array", "hash", "ordhash", and "sequence". In list context,
1183 returns the next key-value pair or beg-end pair for sequence. In
1184 scalar context, returns the next item. The "undef" value is returned
1185 after the iteration has completed.
1186 Internally, the list of keys to return is set when the closure is
1188 constructed. Later keys added to the shared array or hash are not
1189 included. Subsequently, the "undef" value is returned for deleted
1190 keys.
1191 The following example iterates through a shared array in parallel.
1193 use MCE::Hobo;
1195 use MCE::Shared;
1196 my $ar = MCE::Shared->array( 'a' .. 'j' );
1198 sub demo1 {
1200 my ( $wid ) = @_;
1201 while ( my ( $index, $value ) = $ar->next ) {
1202 print "$wid: [ $index ] $value\n";
1203 sleep 1;
1204 }
1205 }
1206 sub demo2 {
1208 my ( $wid ) = @_;
1209 while ( defined ( my $value = $ar->next ) ) {
1210 print "$wid: $value\n";
1211 sleep 1;
1212 }
1213 }
1214 $ar->rewind();
1216 MCE::Hobo->new( \&demo1, $_ ) for 1 .. 3;
1218 MCE::Hobo->waitall(), print "\n";
1219 $ar->rewind();
1221 MCE::Hobo->new( \&demo2, $_ ) for 1 .. 3;
1223 MCE::Hobo->waitall(), print "\n";
1224 __END__
1226 # Output
1228 1: [ 0 ] a
1230 2: [ 1 ] b
1231 3: [ 2 ] c
1232 1: [ 3 ] d
1233 2: [ 5 ] f
1234 3: [ 4 ] e
1235 2: [ 8 ] i
1236 3: [ 6 ] g
1237 1: [ 7 ] h
1238 2: [ 9 ] j
1239 1: a
1241 2: b
1242 3: c
1243 2: e
1244 3: f
1245 1: d
1246 3: g
1247 1: i
1248 2: h
1249 1: j
1250 The form is similar for "sequence". For large sequences, the
1252 "bounds_only" option is recommended. Also, specify "chunk_size"
1253 accordingly. This reduces the amount of traffic to and from the
1254 shared-manager process.
1255 use MCE::Hobo;
1257 use MCE::Shared;
1258 my $N = shift || 4_000_000;
1260 my $pi = MCE::Shared->scalar( 0.0 );
1261 my $seq = MCE::Shared->sequence(
1263 { chunk_size => 200_000, bounds_only => 1 }, 0, $N - 1
1264 );
1265 sub compute_pi {
1267 my ( $wid ) = @_;
1268 # Optionally, also receive the chunk_id value
1270 # while ( my ( $beg, $end, $chunk_id ) = $seq->next ) { ... }
1271 while ( my ( $beg, $end ) = $seq->next ) {
1273 my ( $_pi, $t ) = ( 0.0 );
1274 for my $i ( $beg .. $end ) {
1275 $t = ( $i + 0.5 ) / $N;
1276 $_pi += 4.0 / ( 1.0 + $t * $t );
1277 }
1278 $pi->incrby( $_pi );
1279 }
1280 return;
1282 }
1283 MCE::Hobo->create( \&compute_pi, $_ ) for ( 1 .. 8 );
1285 # ... do other stuff ...
1287 MCE::Hobo->waitall();
1289 printf "pi = %0.13f\n", $pi->get / $N;
1291 __END__
1293 # Output
1295 3.1415926535898
1297 rewind ( index, [, index, ... ] )
1299 rewind ( key, [, key, ... ] )
1300 rewind ( "query string" )
1301 rewind ( )
1302 Rewinds the parallel iterator for MCE::Shared::Array,
1303 MCE::Shared::Hash, or MCE::Shared::Ordhash when no arguments are
1304 given. Otherwise, resets the iterator with given criteria. The
1305 syntax for "query string" is described in the shared module.
1306 # array
1308 $ar->rewind;
1309 $ar->rewind( 0, 1 );
1311 $ar->rewind( "val eq some_value" );
1312 $ar->rewind( "key >= 50 :AND val =~ /sun|moon|air|wind/" );
1313 $ar->rewind( "val eq sun :OR val eq moon :OR val eq foo" );
1314 $ar->rewind( "key =~ /$pattern/" );
1315 while ( my ( $index, $value ) = $ar->next ) {
1317 ...
1318 }
1319 # hash, ordhash
1321 $oh->rewind;
1322 $oh->rewind( "key1", "key2" );
1324 $oh->rewind( "val eq some_value" );
1325 $oh->rewind( "key eq some_key :AND val =~ /sun|moon|air|wind/" );
1326 $oh->rewind( "val eq sun :OR val eq moon :OR val eq foo" );
1327 $oh->rewind( "key =~ /$pattern/" );
1328 while ( my ( $key, $value ) = $oh->next ) {
1330 ...
1331 }
1332 rewind ( { options }, begin, end [, step, format ] )
1334 rewind ( begin, end [, step, format ] )
1335 rewind ( )
1336 Rewinds the parallel iterator for MCE::Shared::Sequence when no
1337 arguments are given. Otherwise, resets the iterator with given
1338 criteria.
1339 # sequence
1341 $seq->rewind;
1342 $seq->rewind( { chunk_size => 10, bounds_only => 1 }, 1, 100 );
1344 while ( my ( $beg, $end ) = $seq->next ) {
1346 for my $i ( $beg .. $end ) {
1347 ...
1348 }
1349 }
1350 $seq->rewind( 1, 100 );
1352 while ( defined ( my $num = $seq->next ) ) {
1354 ...
1355 }
1356 store ( key, value )
1358 Deeply sharing a non-blessed structure recursively is possible with
1359 "store", an alias to "STORE".
1360 use MCE::Shared;
1362 my $h1 = MCE::Shared->hash();
1364 my $h2 = MCE::Shared->hash();
1365 # auto-shares deeply
1367 $h1->store('key', [ 0, 2, 5, { 'foo' => 'bar' } ]);
1368 $h2->{key}[3]{foo} = 'baz'; # via auto-vivification
1369 my $v1 = $h1->get('key')->get(3)->get('foo'); # bar
1371 my $v2 = $h2->get('key')->get(3)->get('foo'); # baz
1372 my $v3 = $h2->{key}[3]{foo}; # baz
1373
1375 init
1376 This method is called by each MCE and Hobo worker automatically
1377 after spawning. The effect is extra parallelism and decreased
1378 latency during inter-process communication to the shared-manager
1379 process. The optional ID (an integer) is modded internally in a
1380 round-robin fashion.
1381 MCE::Shared->init();
1383 MCE::Shared->init( ID );
1384 pid
1386 Returns the process ID of the shared-manager process. This class
1387 method was added in 1.849 for stopping all workers immediately when
1388 exiting a Graphics::Framebuffer application. It returns an undefined
1389 value if the shared-manager is not running. Not useful otherwise if
1390 running threads (i.e. same PID).
1391 MCE::Shared->pid();
1393 $SIG{INT} = $SIG{HUP} = $SIG{TERM} = sub {
1395 # Signal workers and the shared manager all at once
1396 CORE::kill('KILL', MCE::Hobo->list_pids(), MCE::Shared->pid());
1397 exec('reset');
1398 };
1399 start
1401 Starts the shared-manager process. This is done automatically unless
1402 Perl lacks IO::FDPass, needed to share "condvar" and "queue" while
1403 the shared-manager is running.
1404 MCE::Shared->start();
1406 stop
1408 Stops the shared-manager process, wiping all shared data content.
1409 This is called by the "END" block automatically when the script
1410 terminates. However, do stop explicitly to reap the shared-manager
1411 process before exec'ing.
1412 MCE::Shared->stop();
1414 exec('command');
1416
1418 Application-level advisory locking is possible with MCE::Mutex.
1419 use MCE::Hobo;
1421 use MCE::Mutex;
1422 use MCE::Shared;
1423 my $mutex = MCE::Mutex->new();
1425 tie my $cntr, 'MCE::Shared', 0;
1427 sub work {
1429 for ( 1 .. 1000 ) {
1430 $mutex->lock;
1431 # Incrementing involves 2 IPC ops ( FETCH and STORE ).
1433 # Thus, locking is required.
1434 $cntr++;
1435 $mutex->unlock;
1437 }
1438 }
1439 MCE::Hobo->create('work') for ( 1 .. 8 );
1441 MCE::Hobo->waitall;
1442 print $cntr, "\n"; # 8000
1444 Locking is available for shared objects via "lock" and "unlock" methods
1446 since 1.841. Previously, for "condvar" only.
1447 use MCE::Hobo;
1449 use MCE::Shared;
1450 tie my $cntr, 'MCE::Shared', 0;
1452 sub work {
1454 for ( 1 .. 1000 ) {
1455 tied($cntr)->lock;
1456 # Incrementing involves 2 IPC ops ( FETCH and STORE ).
1458 # Thus, locking is required.
1459 $cntr++;
1460 tied($cntr)->unlock;
1462 }
1463 }
1464 MCE::Hobo->create('work') for ( 1 .. 8 );
1466 MCE::Hobo->waitall;
1467 print $cntr, "\n"; # 8000
1469 Typically, locking is not necessary using the OO interface. The reason
1471 is that MCE::Shared is implemented using a single-point of entry for
1472 commands sent to the shared-manager process. Furthermore, the shared
1473 classes include sugar methods for combining set and get in a single
1474 operation.
1475 use MCE::Hobo;
1477 use MCE::Shared;
1478 my $cntr = MCE::Shared->scalar( 0 );
1480 sub work {
1482 for ( 1 .. 1000 ) {
1483 # The next statement increments the value without having
1484 # to call set and get explicitly.
1485 $cntr->incr;
1486 }
1487 }
1488 MCE::Hobo->create('work') for ( 1 .. 8 );
1490 MCE::Hobo->waitall;
1491 print $cntr->get, "\n"; # 8000
1493 Another possibility when running threads is locking via
1495 threads::shared.
1496 use threads;
1498 use threads::shared;
1499 use MCE::Flow;
1501 use MCE::Shared;
1502 my $mutex : shared;
1504 tie my $cntr, 'MCE::Shared', 0;
1506 sub work {
1508 for ( 1 .. 1000 ) {
1509 lock $mutex;
1510 # the next statement involves 2 IPC ops ( get and set )
1512 # thus, locking is required
1513 $cntr++;
1514 }
1515 }
1516 MCE::Flow->run( { max_workers => 8 }, \&work );
1518 MCE::Flow->finish;
1519 print $cntr, "\n"; # 8000
1521 Of the three demonstrations, the OO interface yields the best
1523 performance. This is from the lack of locking at the application
1524 level. The results were obtained from a MacBook Pro (Haswell) running
1525 at 2.6 GHz, 1600 MHz RAM.
1526 CentOS 7.2 VM
1528 -- Perl v5.16.3
1530 MCE::Mutex .... : 0.528 secs.
1531 OO Interface .. : 0.062 secs.
1532 threads::shared : 0.545 secs.
1533 FreeBSD 10.0 VM
1535 -- Perl v5.16.3
1537 MCE::Mutex .... : 0.367 secs.
1538 OO Interface .. : 0.083 secs.
1539 threads::shared : 0.593 secs.
1540 Mac OS X 10.11.6 ( Host OS )
1542 -- Perl v5.18.2
1544 MCE::Mutex .... : 0.397 secs.
1545 OO Interface .. : 0.070 secs.
1546 threads::shared : 0.463 secs.
1547 Solaris 11.2 VM
1549 -- Perl v5.12.5 installed with the OS
1551 MCE::Mutex .... : 0.895 secs.
1552 OO Interface .. : 0.099 secs.
1553 threads::shared : Perl not built to support threads
1554 -- Perl v5.22.2 built with threads support
1556 MCE::Mutex .... : 0.788 secs.
1557 OO Interface .. : 0.086 secs.
1558 threads::shared : 0.895 secs.
1559 Windows 7 VM
1561 -- Perl v5.22.2
1563 MCE::Mutex .... : 1.045 secs.
1564 OO Interface .. : 0.312 secs.
1565 threads::shared : 1.061 secs.
1566 Beginning with MCE::Shared 1.809, the "pipeline" method provides
1568 another way. Included in "Array", "Cache", "Hash", "Minidb", and
1569 "Ordhash", it combines multiple commands for the object to be processed
1570 serially. For shared objects, the call is made atomically due to single
1571 IPC to the shared-manager process.
1572 The "pipeline" method is fully "wantarray"-aware and receives a list of
1574 commands and their arguments. In scalar or list context, it returns
1575 data from the last command in the pipeline.
1576 use MCE::Mutex;
1578 use MCE::Shared;
1579 my $mutex = MCE::Mutex->new();
1581 my $oh = MCE::Shared->ordhash();
1582 my @vals;
1583 # mutex locking
1585 $mutex->lock;
1587 $oh->set( foo => "a_a" );
1588 $oh->set( bar => "b_b" );
1589 $oh->set( baz => "c_c" );
1590 @vals = $oh->mget( qw/ foo bar baz / );
1591 $mutex->unlock;
1592 # pipeline, same thing done atomically
1594 @vals = $oh->pipeline(
1596 [ "set", foo => "a_a" ],
1597 [ "set", bar => "b_b" ],
1598 [ "set", baz => "c_c" ],
1599 [ "mget", qw/ foo bar baz / ]
1600 );
1601 # ( "a_a", "b_b", "c_c" )
1603 There is also "pipeline_ex", same as "pipeline", but returns data for
1605 every command in the pipeline.
1606 @vals = $oh->pipeline_ex(
1608 [ "set", foo => "a_a" ],
1609 [ "set", bar => "b_b" ],
1610 [ "set", baz => "c_c" ]
1611 );
1612 # ( "a_a", "b_b", "c_c" )
1614
1616 Sharing a Python class is possible, starting with the 1.827 release.
1617 The construction is simply calling share with the module option.
1618 Methods are accessible via the OO interface.
1619 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1621 # Python class.
1622 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1623 package My::Class;
1625 use strict;
1627 use warnings;
1628 use Inline::Python qw( py_eval py_bind_class );
1630 py_eval ( <<'END_OF_PYTHON_CLASS' );
1632 class MyClass:
1634 def __init__(self):
1635 self.data = [0,0]
1636 def set (self, key, value):
1638 self.data[key] = value
1639 def get (self, key):
1641 try: return self.data[key]
1642 except KeyError: return None
1643 def incr (self, key):
1645 try: self.data[key] = self.data[key] + 1
1646 except KeyError: self.data[key] = 1
1647 END_OF_PYTHON_CLASS
1649 # Register methods for best performance.
1651 py_bind_class(
1653 'My::Class', '__main__', 'MyClass',
1654 'set', 'get', 'incr'
1655 );
1656 1;
1658 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1660 # Share Python class. Requires MCE::Shared 1.827 or later.
1661 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1662 use strict;
1664 use warnings;
1665 use MCE::Hobo;
1667 use MCE::Shared;
1668 my $py1 = MCE::Shared->share({ module => 'My::Class' });
1670 my $py2 = MCE::Shared->share({ module => 'My::Class' });
1671 MCE::Shared->start;
1673 $py1->set(0, 100);
1675 $py2->set(1, 200);
1676 die "Ooops" unless $py1->get(0) eq '100';
1678 die "Ooops" unless $py2->get(1) eq '200';
1679 sub task {
1681 $py1->incr(0) for 1..50000;
1682 $py2->incr(1) for 1..50000;
1683 }
1684 MCE::Hobo->create(\&task) for 1..3;
1686 MCE::Hobo->waitall;
1687 print $py1->get(0), "\n"; # 150100
1689 print $py2->get(1), "\n"; # 150200
1690
1692 Often, the requirement may call for concurrent logging by many workers.
1693 Calling localtime or gmtime per each log entry is expensive. This uses
1694 the old time-stamp value until one second has elapsed.
1695 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1697 # Logger class.
1698 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1699 package My::Logger;
1701 use strict;
1703 use warnings;
1704 use Time::HiRes qw( time );
1706 # construction
1708 sub new {
1710 my ( $class, %self ) = @_;
1711 open $self{fh}, ">>", $self{path} or return '';
1713 binmode $self{fh};
1714 $self{stamp} = localtime; # or gmtime
1716 $self{time } = time;
1717 bless \%self, $class;
1719 }
1720 # $ob->log("message");
1722 sub log {
1724 my ( $self, $stamp ) = ( shift );
1725 if ( time - $self->{time} > 1.0 ) {
1727 $self->{stamp} = $stamp = localtime; # or gmtime
1728 $self->{time } = time;
1729 }
1730 else {
1731 $stamp = $self->{stamp};
1732 }
1733 print {$self->{fh}} "$stamp --- @_\n";
1735 }
1736 # $ob->autoflush(0);
1738 # $ob->autoflush(1);
1739 sub autoflush {
1741 my ( $self, $flag ) = @_;
1742 if ( defined fileno($self->{fh}) ) {
1744 $flag ? select(( select($self->{fh}), $| = 1 )[0])
1745 : select(( select($self->{fh}), $| = 0 )[0]);
1746 return 1;
1748 }
1749 return;
1751 }
1752 # $ob->binmode($layer);
1754 # $ob->binmode();
1755 sub binmode {
1757 my ( $self, $layer ) = @_;
1758 if ( defined fileno($self->{fh}) ) {
1760 CORE::binmode $self->{fh}, $layer // ':raw';
1761 return 1;
1763 }
1764 return;
1766 }
1767 # $ob->close()
1769 sub close {
1771 my ( $self ) = @_;
1772 if ( defined fileno($self->{fh}) ) {
1774 close $self->{'fh'};
1775 }
1776 return;
1778 }
1779 # $ob->flush()
1781 sub flush {
1783 my ( $self ) = @_;
1784 if ( defined fileno($self->{fh}) ) {
1786 my $old_fh = select $self->{fh};
1787 my $old_af = $|; $| = 1; $| = $old_af;
1788 select $old_fh;
1789 return 1;
1791 }
1792 return;
1794 }
1795 1;
1797 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1799 # Concurrent logger demo. Requires MCE::Shared 1.827 or later.
1800 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1801 use strict;
1803 use warnings;
1804 use MCE::Hobo;
1806 use MCE::Shared;
1807 my $file = "log.txt";
1809 my $pid = $$;
1810 my $ob = MCE::Shared->share( { module => 'My::Logger' }, path => $file )
1812 or die "open error '$file': $!";
1813 # $ob->autoflush(1); # optional, flush writes immediately
1815 sub work {
1817 my $id = shift;
1818 for ( 1 .. 250_000 ) {
1819 $ob->log("Hello from $id: $_");
1820 }
1821 }
1822 MCE::Hobo->create('work', $_) for 1 .. 4;
1824 MCE::Hobo->waitall;
1825 # Threads and multi-process safety for closing the handle.
1827 sub CLONE { $pid = 0; }
1829 END { $ob->close if $ob && $pid == $$; }
1831
1833 The following presents a concurrent Tie::File demonstration. Each
1834 element in the array corresponds to a record in the text file. JSON,
1835 being readable, seems appropiate for encoding complex objects.
1836 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1838 # Class extending Tie::File with two sugar methods.
1839 # Requires MCE::Shared 1.827 or later.
1840 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1841 package My::File;
1843 use strict;
1845 use warnings;
1846 use Tie::File;
1848 our @ISA = 'Tie::File';
1850 # $ob->append('string');
1852 sub append {
1854 my ($self, $key) = @_;
1855 my $val = $self->FETCH($key); $val .= $_[2];
1856 $self->STORE($key, $val);
1857 length $val;
1858 }
1859 # $ob->incr($key);
1861 sub incr {
1863 my ( $self, $key ) = @_;
1864 my $val = $self->FETCH($key); $val += 1;
1865 $self->STORE($key, $val);
1866 $val;
1867 }
1868 1;
1870 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1872 # The MCE::Mutex module isn't needed unless IPC involves two or
1873 # more trips for the underlying action.
1874 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1875 use strict;
1877 use warnings;
1878 use MCE::Hobo;
1880 use MCE::Mutex;
1881 use MCE::Shared;
1882 use JSON::MaybeXS;
1884 # Safety for data having line breaks.
1886 use constant EOL => "\x{0a}~\x{0a}";
1887 my $file = 'file.txt';
1889 my $mutex = MCE::Mutex->new();
1890 my $pid = $$;
1891 my $ob = tie my @db, 'MCE::Shared', { module => 'My::File' }, $file,
1893 recsep => EOL or die "open error '$file': $!";
1894 $ob->encoder( \&JSON::MaybeXS::encode_json );
1896 $ob->decoder( \&JSON::MaybeXS::decode_json );
1897 $db[20] = 0; # a counter at offset 20 into the array
1899 $db[21] = [ qw/ foo bar / ]; # store complex structure
1900 sub task {
1902 my $id = sprintf "%02s", shift;
1903 my $row = int($id) - 1;
1904 my $chr = sprintf "%c", 97 + $id - 1;
1905 # A mutex isn't necessary when storing a value.
1907 # Ditto for fetching a value.
1908 $db[$row] = "Hello from $id: "; # 1 trip
1910 my $val = length $db[$row]; # 1 trip
1911 # A mutex may be necessary for updates involving 2 or
1913 # more trips (FETCH and STORE) during IPC, from and to
1914 # the shared-manager process, unless a unique row.
1915 for ( 1 .. 40 ) {
1917 # $db[$row] .= $id; # 2 trips, unique row - okay
1918 $ob->append($row, $chr); # 1 trip via the OO interface
1919 # $mu->lock;
1921 # $db[20] += 1; # incrementing counter, 2 trips
1922 # $mu->unlock;
1923 $ob->incr(20); # same thing via OO, 1 trip
1925 }
1926 my $len = length $db[$row]; # 1 trip
1928 printf "hobo %2d : %d\n", $id, $len;
1930 }
1931 MCE::Hobo->create('task', $_) for 1 .. 20;
1933 MCE::Hobo->waitall;
1934 printf "counter : %d\n", $db[20];
1936 print $db[21]->[0], "\n"; # foo
1937 # Threads and multi-process safety for closing the handle.
1939 sub CLONE { $pid = 0; }
1941 END {
1943 if ( $pid == $$ ) {
1944 undef $ob; # important, undef $ob before @db
1945 untie @db; # untie @db to flush pending writes
1946 }
1947 }
1948
1950 MCE::Shared requires Perl 5.10.1 or later. The IO::FDPass module is
1951 highly recommended on UNIX and Windows. This module does not install it
1952 by default.
1953
1955 The source and examples are hosted at GitHub.
1956 • <https://github.com/marioroy/mce-shared>
1958 • <https://github.com/marioroy/mce-examples>
1960
1962 MCE, MCE::Hobo
1963
1965 Mario E. Roy, <marioeroy AT gmail DOT com>
1966
1968 Copyright (C) 2016-2023 by Mario E. Roy
1969 MCE::Shared is released under the same license as Perl.
1971 See <https://dev.perl.org/licenses/> for more information.
1973perl v5.36.0 2023-01-20 MCE::Shared(3)