This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to threads::shared 1.41
[perl5.git] / dist / threads-shared / lib / threads / shared.pm
CommitLineData
b050c948 1package threads::shared;
73e09c8f 2
c46325ea 3use 5.008;
7473853a 4
b050c948
AB
5use strict;
6use warnings;
73e09c8f 7
373098c0
JH
8use Scalar::Util qw(reftype refaddr blessed);
9
2d282673 10our $VERSION = '1.41';
7473853a
SP
11my $XS_VERSION = $VERSION;
12$VERSION = eval $VERSION;
13
14# Declare that we have been loaded
15$threads::shared::threads_shared = 1;
16
2d282673
JH
17# Method of complaint about things we can't clone
18$threads::shared::clone_warn = undef;
19
7473853a
SP
20# Load the XS code, if applicable
21if ($threads::threads) {
22 require XSLoader;
23 XSLoader::load('threads::shared', $XS_VERSION);
24
25 *is_shared = \&_id;
26
27} else {
28 # String eval is generally evil, but we don't want these subs to
29 # exist at all if 'threads' is not loaded successfully.
30 # Vivifying them conditionally this way saves on average about 4K
31 # of memory per thread.
32 eval <<'_MARKER_';
33 sub share (\[$@%]) { return $_[0] }
34 sub is_shared (\[$@%]) { undef }
35 sub cond_wait (\[$@%];\[$@%]) { undef }
36 sub cond_timedwait (\[$@%]$;\[$@%]) { undef }
37 sub cond_signal (\[$@%]) { undef }
38 sub cond_broadcast (\[$@%]) { undef }
39_MARKER_
40}
41
42
43### Export ###
44
45sub import
46{
47 # Exported subroutines
48 my @EXPORT = qw(share is_shared cond_wait cond_timedwait
373098c0 49 cond_signal cond_broadcast shared_clone);
5c360ac5 50 if ($threads::threads) {
7473853a 51 push(@EXPORT, 'bless');
5c360ac5 52 }
7473853a
SP
53
54 # Export subroutine names
55 my $caller = caller();
56 foreach my $sym (@EXPORT) {
57 no strict 'refs';
58 *{$caller.'::'.$sym} = \&{$sym};
df5c998e
EM
59 }
60}
b050c948 61
7473853a 62
373098c0
JH
63# Predeclarations for internal functions
64my ($make_shared);
65
66
7473853a 67### Methods, etc. ###
dab065ea 68
6b85e4fe
NIS
69sub threads::shared::tie::SPLICE
70{
7473853a
SP
71 require Carp;
72 Carp::croak('Splice not implemented for shared arrays');
6b85e4fe
NIS
73}
74
373098c0
JH
75
76# Create a thread-shared clone of a complex data structure or object
77sub shared_clone
78{
79 if (@_ != 1) {
80 require Carp;
81 Carp::croak('Usage: shared_clone(REF)');
82 }
83
84 return $make_shared->(shift, {});
85}
86
87
88### Internal Functions ###
89
90# Used by shared_clone() to recursively clone
91# a complex data structure or object
92$make_shared = sub {
93 my ($item, $cloned) = @_;
94
95 # Just return the item if:
96 # 1. Not a ref;
97 # 2. Already shared; or
98 # 3. Not running 'threads'.
99 return $item if (! ref($item) || is_shared($item) || ! $threads::threads);
100
101 # Check for previously cloned references
102 # (this takes care of circular refs as well)
103 my $addr = refaddr($item);
104 if (exists($cloned->{$addr})) {
105 # Return the already existing clone
106 return $cloned->{$addr};
107 }
108
109 # Make copies of array, hash and scalar refs and refs of refs
110 my $copy;
111 my $ref_type = reftype($item);
112
113 # Copy an array ref
114 if ($ref_type eq 'ARRAY') {
115 # Make empty shared array ref
116 $copy = &share([]);
117 # Add to clone checking hash
118 $cloned->{$addr} = $copy;
119 # Recursively copy and add contents
120 push(@$copy, map { $make_shared->($_, $cloned) } @$item);
121 }
122
123 # Copy a hash ref
124 elsif ($ref_type eq 'HASH') {
125 # Make empty shared hash ref
126 $copy = &share({});
127 # Add to clone checking hash
128 $cloned->{$addr} = $copy;
129 # Recursively copy and add contents
130 foreach my $key (keys(%{$item})) {
131 $copy->{$key} = $make_shared->($item->{$key}, $cloned);
132 }
133 }
134
135 # Copy a scalar ref
136 elsif ($ref_type eq 'SCALAR') {
137 $copy = \do{ my $scalar = $$item; };
138 share($copy);
373098c0
JH
139 # Add to clone checking hash
140 $cloned->{$addr} = $copy;
141 }
142
143 # Copy of a ref of a ref
144 elsif ($ref_type eq 'REF') {
145 # Special handling for $x = \$x
146 if ($addr == refaddr($$item)) {
147 $copy = \$copy;
148 share($copy);
149 $cloned->{$addr} = $copy;
150 } else {
151 my $tmp;
152 $copy = \$tmp;
153 share($copy);
154 # Add to clone checking hash
155 $cloned->{$addr} = $copy;
156 # Recursively copy and add contents
157 $tmp = $make_shared->($$item, $cloned);
158 }
159
160 } else {
161 require Carp;
2d282673
JH
162 if (! defined($threads::shared::clone_warn)) {
163 Carp::croak("Unsupported ref type: ", $ref_type);
164 } elsif ($threads::shared::clone_warn) {
165 Carp::carp("Unsupported ref type: ", $ref_type);
166 }
167 return undef;
373098c0
JH
168 }
169
170 # If input item is an object, then bless the copy into the same class
171 if (my $class = blessed($item)) {
172 bless($copy, $class);
173 }
174
175 # Clone READONLY flag
a469502f
RGS
176 if ($ref_type eq 'SCALAR') {
177 if (Internals::SvREADONLY($$item)) {
178 Internals::SvREADONLY($$copy, 1) if ($] >= 5.008003);
179 }
180 }
373098c0 181 if (Internals::SvREADONLY($item)) {
a469502f 182 Internals::SvREADONLY($copy, 1) if ($] >= 5.008003);
373098c0
JH
183 }
184
185 return $copy;
186};
187
7473853a
SP
1881;
189
b050c948
AB
190__END__
191
192=head1 NAME
193
194threads::shared - Perl extension for sharing data structures between threads
195
7473853a
SP
196=head1 VERSION
197
2d282673 198This document describes threads::shared version 1.41
7473853a 199
b050c948
AB
200=head1 SYNOPSIS
201
73e09c8f 202 use threads;
b050c948
AB
203 use threads::shared;
204
7473853a 205 my $var :shared;
373098c0
JH
206 my %hsh :shared;
207 my @ary :shared;
38875929 208
3b29be8d 209 my ($scalar, @array, %hash);
4cab98c0
SG
210 share($scalar);
211 share(@array);
aaf3876d 212 share(%hash);
373098c0
JH
213
214 $var = $scalar_value;
215 $var = $shared_ref_value;
216 $var = shared_clone($non_shared_ref_value);
217 $var = shared_clone({'foo' => [qw/foo bar baz/]});
218
219 $hsh{'foo'} = $scalar_value;
220 $hsh{'bar'} = $shared_ref_value;
221 $hsh{'baz'} = shared_clone($non_shared_ref_value);
222 $hsh{'quz'} = shared_clone([1..3]);
223
224 $ary[0] = $scalar_value;
225 $ary[1] = $shared_ref_value;
226 $ary[2] = shared_clone($non_shared_ref_value);
227 $ary[3] = shared_clone([ {}, [] ]);
b050c948 228
38875929
DM
229 { lock(%hash); ... }
230
b050c948 231 cond_wait($scalar);
a0e036c1 232 cond_timedwait($scalar, time() + 30);
515f0976
AB
233 cond_broadcast(@array);
234 cond_signal(%hash);
b050c948 235
7473853a 236 my $lockvar :shared;
a0e036c1
MP
237 # condition var != lock var
238 cond_wait($var, $lockvar);
239 cond_timedwait($var, time()+30, $lockvar);
240
b050c948
AB
241=head1 DESCRIPTION
242
38875929 243By default, variables are private to each thread, and each newly created
7473853a 244thread gets a private copy of each existing variable. This module allows you
373098c0
JH
245to share variables across different threads (and pseudo-forks on Win32). It
246is used together with the L<threads> module.
247
248This module supports the sharing of the following data types only: scalars
249and scalar refs, arrays and array refs, and hashes and hash refs.
b050c948 250
515f0976 251=head1 EXPORT
b050c948 252
373098c0
JH
253The following functions are exported by this module: C<share>,
254C<shared_clone>, C<is_shared>, C<cond_wait>, C<cond_timedwait>, C<cond_signal>
255and C<cond_broadcast>
515f0976 256
7473853a
SP
257Note that if this module is imported when L<threads> has not yet been loaded,
258then these functions all become no-ops. This makes it possible to write
259modules that will work in both threaded and non-threaded environments.
e67b86b3 260
515f0976
AB
261=head1 FUNCTIONS
262
263=over 4
264
265=item share VARIABLE
266
373098c0
JH
267C<share> takes a variable and marks it as shared:
268
269 my ($scalar, @array, %hash);
270 share($scalar);
271 share(@array);
272 share(%hash);
273
274C<share> will return the shared rvalue, but always as a reference.
515f0976 275
373098c0
JH
276Variables can also be marked as shared at compile time by using the
277C<:shared> attribute:
38875929 278
373098c0 279 my ($var, %hash, @array) :shared;
caf25f3b 280
373098c0
JH
281Shared variables can only store scalars, refs of shared variables, or
282refs of shared data (discussed in next section):
7473853a 283
373098c0
JH
284 my ($var, %hash, @array) :shared;
285 my $bork;
286
287 # Storing scalars
288 $var = 1;
289 $hash{'foo'} = 'bar';
290 $array[0] = 1.5;
291
292 # Storing shared refs
293 $var = \%hash;
294 $hash{'ary'} = \@array;
295 $array[1] = \$var;
296
297 # The following are errors:
298 # $var = \$bork; # ref of non-shared variable
299 # $hash{'bork'} = []; # non-shared array ref
300 # push(@array, { 'x' => 1 }); # non-shared hash ref
7473853a 301
373098c0 302=item shared_clone REF
ca5ff8b2 303
373098c0 304C<shared_clone> takes a reference, and returns a shared version of its
2e58fc35 305argument, performing a deep copy on any non-shared elements. Any shared
373098c0
JH
306elements in the argument are used as is (i.e., they are not cloned).
307
308 my $cpy = shared_clone({'foo' => [qw/foo bar baz/]});
309
310Object status (i.e., the class an object is blessed into) is also cloned.
311
312 my $obj = {'foo' => [qw/foo bar baz/]};
313 bless($obj, 'Foo');
314 my $cpy = shared_clone($obj);
315 print(ref($cpy), "\n"); # Outputs 'Foo'
316
317For cloning empty array or hash refs, the following may also be used:
318
2e58fc35
JH
319 $var = &share([]); # Same as $var = shared_clone([]);
320 $var = &share({}); # Same as $var = shared_clone({});
ca5ff8b2 321
2d282673
JH
322Not all Perl data types can be cloned (e.g., globs, code refs). By default,
323C<shared_clone> will L<croak|Carp> if it encounters such items. To change
324this behaviour to a warning, then set the following:
325
326 $threads::shared::clone_warn = 1;
327
328In this case, C<undef> will be substituted for the item to be cloned. If
329set to zero:
330
331 $threads::shared::clone_warn = 0;
332
333then the C<undef> substitution will be performed silently.
334
7473853a
SP
335=item is_shared VARIABLE
336
337C<is_shared> checks if the specified variable is shared or not. If shared,
338returns the variable's internal ID (similar to
339L<refaddr()|Scalar::Util/"refaddr EXPR">). Otherwise, returns C<undef>.
340
341 if (is_shared($var)) {
342 print("\$var is shared\n");
343 } else {
344 print("\$var is not shared\n");
345 }
ca5ff8b2 346
c6cab44f
JH
347When used on an element of an array or hash, C<is_shared> checks if the
348specified element belongs to a shared array or hash. (It does not check
349the contents of that element.)
350
351 my %hash :shared;
352 if (is_shared(%hash)) {
353 print("\%hash is shared\n");
354 }
355
356 $hash{'elem'} = 1;
357 if (is_shared($hash{'elem'})) {
358 print("\$hash{'elem'} is in a shared hash\n");
359 }
360
515f0976
AB
361=item lock VARIABLE
362
c6cab44f
JH
363C<lock> places a B<advisory> lock on a variable until the lock goes out of
364scope. If the variable is locked by another thread, the C<lock> call will
365block until it's available. Multiple calls to C<lock> by the same thread from
366within dynamically nested scopes are safe -- the variable will remain locked
367until the outermost lock on the variable goes out of scope.
7473853a 368
c6cab44f 369C<lock> follows references exactly I<one> level:
515f0976 370
c6cab44f
JH
371 my %hash :shared;
372 my $ref = \%hash;
373 lock($ref); # This is equivalent to lock(%hash)
515f0976 374
7473853a
SP
375Note that you cannot explicitly unlock a variable; you can only wait for the
376lock to go out of scope. This is most easily accomplished by locking the
377variable inside a block.
515f0976 378
7473853a
SP
379 my $var :shared;
380 {
381 lock($var);
382 # $var is locked from here to the end of the block
383 ...
384 }
385 # $var is now unlocked
386
c6cab44f
JH
387As locks are advisory, they do not prevent data access or modification by
388another thread that does not itself attempt to obtain a lock on the variable.
389
390You cannot lock the individual elements of a container variable:
391
392 my %hash :shared;
393 $hash{'foo'} = 'bar';
394 #lock($hash{'foo'}); # Error
395 lock(%hash); # Works
396
7473853a
SP
397If you need more fine-grained control over shared variable access, see
398L<Thread::Semaphore>.
515f0976
AB
399
400=item cond_wait VARIABLE
401
a0e036c1
MP
402=item cond_wait CONDVAR, LOCKVAR
403
7473853a
SP
404The C<cond_wait> function takes a B<locked> variable as a parameter, unlocks
405the variable, and blocks until another thread does a C<cond_signal> or
406C<cond_broadcast> for that same locked variable. The variable that
2d282673 407C<cond_wait> blocked on is re-locked after the C<cond_wait> is satisfied. If
7473853a 408there are multiple threads C<cond_wait>ing on the same variable, all but one
7c8caac0 409will re-block waiting to reacquire the lock on the variable. (So if you're only
2d282673 410using C<cond_wait> for synchronization, give up the lock as soon as possible).
7473853a
SP
411The two actions of unlocking the variable and entering the blocked wait state
412are atomic, the two actions of exiting from the blocked wait state and
7c8caac0 413re-locking the variable are not.
7473853a
SP
414
415In its second form, C<cond_wait> takes a shared, B<unlocked> variable followed
416by a shared, B<locked> variable. The second variable is unlocked and thread
417execution suspended until another thread signals the first variable.
418
419It is important to note that the variable can be notified even if no thread
420C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
421important to check the value of the variable and go back to waiting if the
422requirement is not fulfilled. For example, to pause until a shared counter
423drops to zero:
424
63790022 425 { lock($counter); cond_wait($counter) until $counter == 0; }
a0e036c1
MP
426
427=item cond_timedwait VARIABLE, ABS_TIMEOUT
428
429=item cond_timedwait CONDVAR, ABS_TIMEOUT, LOCKVAR
430
7473853a 431In its two-argument form, C<cond_timedwait> takes a B<locked> variable and an
2d282673
JH
432absolute timeout in I<epoch> seconds (see L<time() in perlfunc|perlfunc/time>
433for more) as parameters, unlocks the variable, and blocks until the
7473853a
SP
434timeout is reached or another thread signals the variable. A false value is
435returned if the timeout is reached, and a true value otherwise. In either
436case, the variable is re-locked upon return.
a0e036c1 437
7473853a
SP
438Like C<cond_wait>, this function may take a shared, B<locked> variable as an
439additional parameter; in this case the first parameter is an B<unlocked>
440condition variable protected by a distinct lock variable.
a0e036c1 441
7473853a
SP
442Again like C<cond_wait>, waking up and reacquiring the lock are not atomic,
443and you should always check your desired condition after this function
444returns. Since the timeout is an absolute value, however, it does not have to
445be recalculated with each pass:
a0e036c1 446
7473853a
SP
447 lock($var);
448 my $abs = time() + 15;
449 until ($ok = desired_condition($var)) {
a0e036c1 450 last if !cond_timedwait($var, $abs);
7473853a
SP
451 }
452 # we got it if $ok, otherwise we timed out!
515f0976
AB
453
454=item cond_signal VARIABLE
455
7473853a
SP
456The C<cond_signal> function takes a B<locked> variable as a parameter and
457unblocks one thread that's C<cond_wait>ing on that variable. If more than one
458thread is blocked in a C<cond_wait> on that variable, only one (and which one
459is indeterminate) will be unblocked.
515f0976 460
7473853a
SP
461If there are no threads blocked in a C<cond_wait> on the variable, the signal
462is discarded. By always locking before signaling, you can (with care), avoid
463signaling before another thread has entered cond_wait().
38875929 464
7473853a
SP
465C<cond_signal> will normally generate a warning if you attempt to use it on an
466unlocked variable. On the rare occasions where doing this may be sensible, you
ba2940ce 467can suppress the warning with:
38875929 468
7473853a 469 { no warnings 'threads'; cond_signal($foo); }
515f0976
AB
470
471=item cond_broadcast VARIABLE
472
473The C<cond_broadcast> function works similarly to C<cond_signal>.
7473853a
SP
474C<cond_broadcast>, though, will unblock B<all> the threads that are blocked in
475a C<cond_wait> on the locked variable, rather than only one.
b050c948 476
4cab98c0 477=back
dab065ea 478
7473853a
SP
479=head1 OBJECTS
480
481L<threads::shared> exports a version of L<bless()|perlfunc/"bless REF"> that
2b936299 482works on shared objects such that I<blessings> propagate across threads.
7473853a 483
373098c0
JH
484 # Create a shared 'Foo' object
485 my $foo :shared = shared_clone({});
486 bless($foo, 'Foo');
7473853a 487
373098c0
JH
488 # Create a shared 'Bar' object
489 my $bar :shared = shared_clone({});
490 bless($bar, 'Bar');
7473853a
SP
491
492 # Put 'bar' inside 'foo'
493 $foo->{'bar'} = $bar;
494
495 # Rebless the objects via a thread
496 threads->create(sub {
497 # Rebless the outer object
373098c0 498 bless($foo, 'Yin');
7473853a
SP
499
500 # Cannot directly rebless the inner object
373098c0 501 #bless($foo->{'bar'}, 'Yang');
7473853a
SP
502
503 # Retrieve and rebless the inner object
504 my $obj = $foo->{'bar'};
373098c0 505 bless($obj, 'Yang');
7473853a
SP
506 $foo->{'bar'} = $obj;
507
508 })->join();
509
373098c0
JH
510 print(ref($foo), "\n"); # Prints 'Yin'
511 print(ref($foo->{'bar'}), "\n"); # Prints 'Yang'
512 print(ref($bar), "\n"); # Also prints 'Yang'
7473853a 513
dab065ea
AB
514=head1 NOTES
515
33d16ee7
JH
516L<threads::shared> is designed to disable itself silently if threads are not
517available. This allows you to write modules and packages that can be used
518in both threaded and non-threaded applications.
519
520If you want access to threads, you must C<use threads> before you
7473853a
SP
521C<use threads::shared>. L<threads> will emit a warning if you use it after
522L<threads::shared>.
dab065ea 523
7473853a 524=head1 BUGS AND LIMITATIONS
b050c948 525
7473853a
SP
526When C<share> is used on arrays, hashes, array refs or hash refs, any data
527they contain will be lost.
515f0976 528
7473853a
SP
529 my @arr = qw(foo bar baz);
530 share(@arr);
531 # @arr is now empty (i.e., == ());
b050c948 532
7473853a
SP
533 # Create a 'foo' object
534 my $foo = { 'data' => 99 };
535 bless($foo, 'foo');
58122748 536
7473853a
SP
537 # Share the object
538 share($foo); # Contents are now wiped out
539 print("ERROR: \$foo is empty\n")
540 if (! exists($foo->{'data'}));
3d32476b 541
7473853a
SP
542Therefore, populate such variables B<after> declaring them as shared. (Scalar
543and scalar refs are not affected by this problem.)
544
545It is often not wise to share an object unless the class itself has been
2b936299
RGS
546written to support sharing. For example, an object's destructor may get
547called multiple times, once for each thread's scope exit. Another danger is
548that the contents of hash-based objects will be lost due to the above
549mentioned limitation. See F<examples/class.pl> (in the CPAN distribution of
550this module) for how to create a class that supports object sharing.
b050c948 551
7d585d2f
FC
552Destructors may not be called on objects if those objects still exist at
553global destruction time. If the destructors must be called, make sure
554there are no circular references and that nothing is referencing the
555objects, before the program ends.
b9e224a7 556
1a3f0f1d
SM
557Does not support C<splice> on arrays. Does not support explicitly changing
558array lengths via $#array -- use C<push> and C<pop> instead.
b050c948 559
7473853a
SP
560Taking references to the elements of shared arrays and hashes does not
561autovivify the elements, and neither does slicing a shared array/hash over
562non-existent indices/keys autovivify the elements.
563
c6cab44f
JH
564C<share()> allows you to C<< share($hashref->{key}) >> and
565C<< share($arrayref->[idx]) >> without giving any error message. But the
566C<< $hashref->{key} >> or C<< $arrayref->[idx] >> is B<not> shared, causing
567the error "lock can only be used on shared values" to occur when you attempt
568to C<< lock($hasref->{key}) >> or C<< lock($arrayref->[idx]) >> in another
569thread.
b050c948 570
f6d55995
JH
571Using L<refaddr()|Scalar::Util/"refaddr EXPR">) is unreliable for testing
572whether or not two shared references are equivalent (e.g., when testing for
1357b38e 573circular references). Use L<is_shared()|/"is_shared VARIABLE">, instead:
f6d55995
JH
574
575 use threads;
576 use threads::shared;
577 use Scalar::Util qw(refaddr);
578
579 # If ref is shared, use threads::shared's internal ID.
580 # Otherwise, use refaddr().
581 my $addr1 = is_shared($ref1) || refaddr($ref1);
582 my $addr2 = is_shared($ref2) || refaddr($ref2);
583
584 if ($addr1 == $addr2) {
585 # The refs are equivalent
586 }
587
2e58fc35
JH
588L<each()|perlfunc/"each HASH"> does not work properly on shared references
589embedded in shared structures. For example:
590
591 my %foo :shared;
592 $foo{'bar'} = shared_clone({'a'=>'x', 'b'=>'y', 'c'=>'z'});
593
594 while (my ($key, $val) = each(%{$foo{'bar'}})) {
595 ...
596 }
597
598Either of the following will work instead:
599
600 my $ref = $foo{'bar'};
601 while (my ($key, $val) = each(%{$ref})) {
602 ...
603 }
604
605 foreach my $key (keys(%{$foo{'bar'}})) {
606 my $val = $foo{'bar'}{$key};
607 ...
608 }
609
7473853a 610View existing bug reports at, and submit any new bugs, problems, patches, etc.
794f4697 611to: L<http://rt.cpan.org/Public/Dist/Display.html?Name=threads-shared>
515f0976 612
b050c948
AB
613=head1 SEE ALSO
614
7473853a
SP
615L<threads::shared> Discussion Forum on CPAN:
616L<http://www.cpanforum.com/dist/threads-shared>
617
7473853a
SP
618L<threads>, L<perlthrtut>
619
620L<http://www.perl.com/pub/a/2002/06/11/threads.html> and
621L<http://www.perl.com/pub/a/2002/09/04/threads.html>
622
623Perl threads mailing list:
a2770437 624L<http://lists.perl.org/list/ithreads.html>
7473853a
SP
625
626=head1 AUTHOR
627
628Artur Bergman E<lt>sky AT crucially DOT netE<gt>
629
7473853a
SP
630Documentation borrowed from the old Thread.pm.
631
632CPAN version produced by Jerry D. Hedden E<lt>jdhedden AT cpan DOT orgE<gt>.
b050c948 633
6c791b15
JH
634=head1 LICENSE
635
636threads::shared is released under the same license as Perl.
637
b050c948 638=cut