1 package threads::shared;
8 use Scalar::Util qw(reftype refaddr blessed);
10 our $VERSION = '1.22';
11 my $XS_VERSION = $VERSION;
12 $VERSION = eval $VERSION;
14 # Declare that we have been loaded
15 $threads::shared::threads_shared = 1;
17 # Load the XS code, if applicable
18 if ($threads::threads) {
20 XSLoader::load('threads::shared', $XS_VERSION);
25 # String eval is generally evil, but we don't want these subs to
26 # exist at all if 'threads' is not loaded successfully.
27 # Vivifying them conditionally this way saves on average about 4K
28 # of memory per thread.
30 sub share (\[$@%]) { return $_[0] }
31 sub is_shared (\[$@%]) { undef }
32 sub cond_wait (\[$@%];\[$@%]) { undef }
33 sub cond_timedwait (\[$@%]$;\[$@%]) { undef }
34 sub cond_signal (\[$@%]) { undef }
35 sub cond_broadcast (\[$@%]) { undef }
44 # Exported subroutines
45 my @EXPORT = qw(share is_shared cond_wait cond_timedwait
46 cond_signal cond_broadcast shared_clone);
47 if ($threads::threads) {
48 push(@EXPORT, 'bless');
51 # Export subroutine names
52 my $caller = caller();
53 foreach my $sym (@EXPORT) {
55 *{$caller.'::'.$sym} = \&{$sym};
60 # Predeclarations for internal functions
66 sub threads::shared::tie::SPLICE
69 Carp::croak('Splice not implemented for shared arrays');
73 # Create a thread-shared clone of a complex data structure or object
78 Carp::croak('Usage: shared_clone(REF)');
81 return $make_shared->(shift, {});
85 ### Internal Functions ###
87 # Used by shared_clone() to recursively clone
88 # a complex data structure or object
90 my ($item, $cloned) = @_;
92 # Just return the item if:
94 # 2. Already shared; or
95 # 3. Not running 'threads'.
96 return $item if (! ref($item) || is_shared($item) || ! $threads::threads);
98 # Check for previously cloned references
99 # (this takes care of circular refs as well)
100 my $addr = refaddr($item);
101 if (exists($cloned->{$addr})) {
102 # Return the already existing clone
103 return $cloned->{$addr};
106 # Make copies of array, hash and scalar refs and refs of refs
108 my $ref_type = reftype($item);
111 if ($ref_type eq 'ARRAY') {
112 # Make empty shared array ref
114 # Add to clone checking hash
115 $cloned->{$addr} = $copy;
116 # Recursively copy and add contents
117 push(@$copy, map { $make_shared->($_, $cloned) } @$item);
121 elsif ($ref_type eq 'HASH') {
122 # Make empty shared hash ref
124 # Add to clone checking hash
125 $cloned->{$addr} = $copy;
126 # Recursively copy and add contents
127 foreach my $key (keys(%{$item})) {
128 $copy->{$key} = $make_shared->($item->{$key}, $cloned);
133 elsif ($ref_type eq 'SCALAR') {
134 $copy = \do{ my $scalar = $$item; };
136 # Clone READONLY flag
137 if (Internals::SvREADONLY($$item)) {
138 Internals::SvREADONLY($$copy, 1);
140 # Add to clone checking hash
141 $cloned->{$addr} = $copy;
144 # Copy of a ref of a ref
145 elsif ($ref_type eq 'REF') {
146 # Special handling for $x = \$x
147 if ($addr == refaddr($$item)) {
150 $cloned->{$addr} = $copy;
155 # Add to clone checking hash
156 $cloned->{$addr} = $copy;
157 # Recursively copy and add contents
158 $tmp = $make_shared->($$item, $cloned);
163 Carp::croak("Unsupported ref type: ", $ref_type);
166 # If input item is an object, then bless the copy into the same class
167 if (my $class = blessed($item)) {
168 bless($copy, $class);
171 # Clone READONLY flag
172 if (Internals::SvREADONLY($item)) {
173 Internals::SvREADONLY($copy, 1);
185 threads::shared - Perl extension for sharing data structures between threads
189 This document describes threads::shared version 1.22
200 my ($scalar, @array, %hash);
205 $var = $scalar_value;
206 $var = $shared_ref_value;
207 $var = shared_clone($non_shared_ref_value);
208 $var = shared_clone({'foo' => [qw/foo bar baz/]});
210 $hsh{'foo'} = $scalar_value;
211 $hsh{'bar'} = $shared_ref_value;
212 $hsh{'baz'} = shared_clone($non_shared_ref_value);
213 $hsh{'quz'} = shared_clone([1..3]);
215 $ary[0] = $scalar_value;
216 $ary[1] = $shared_ref_value;
217 $ary[2] = shared_clone($non_shared_ref_value);
218 $ary[3] = shared_clone([ {}, [] ]);
223 cond_timedwait($scalar, time() + 30);
224 cond_broadcast(@array);
228 # condition var != lock var
229 cond_wait($var, $lockvar);
230 cond_timedwait($var, time()+30, $lockvar);
234 By default, variables are private to each thread, and each newly created
235 thread gets a private copy of each existing variable. This module allows you
236 to share variables across different threads (and pseudo-forks on Win32). It
237 is used together with the L<threads> module.
239 This module supports the sharing of the following data types only: scalars
240 and scalar refs, arrays and array refs, and hashes and hash refs.
244 The following functions are exported by this module: C<share>,
245 C<shared_clone>, C<is_shared>, C<cond_wait>, C<cond_timedwait>, C<cond_signal>
246 and C<cond_broadcast>
248 Note that if this module is imported when L<threads> has not yet been loaded,
249 then these functions all become no-ops. This makes it possible to write
250 modules that will work in both threaded and non-threaded environments.
258 C<share> takes a variable and marks it as shared:
260 my ($scalar, @array, %hash);
265 C<share> will return the shared rvalue, but always as a reference.
267 Variables can also be marked as shared at compile time by using the
268 C<:shared> attribute:
270 my ($var, %hash, @array) :shared;
272 Shared variables can only store scalars, refs of shared variables, or
273 refs of shared data (discussed in next section):
275 my ($var, %hash, @array) :shared;
280 $hash{'foo'} = 'bar';
283 # Storing shared refs
285 $hash{'ary'} = \@array;
288 # The following are errors:
289 # $var = \$bork; # ref of non-shared variable
290 # $hash{'bork'} = []; # non-shared array ref
291 # push(@array, { 'x' => 1 }); # non-shared hash ref
293 =item shared_clone REF
295 C<shared_clone> takes a reference, and returns a shared version of its
296 argument, preforming a deep copy on any non-shared elements. Any shared
297 elements in the argument are used as is (i.e., they are not cloned).
299 my $cpy = shared_clone({'foo' => [qw/foo bar baz/]});
301 Object status (i.e., the class an object is blessed into) is also cloned.
303 my $obj = {'foo' => [qw/foo bar baz/]};
305 my $cpy = shared_clone($obj);
306 print(ref($cpy), "\n"); # Outputs 'Foo'
308 For cloning empty array or hash refs, the following may also be used:
310 $var = &share([]); # Same as $var = share_clone([]);
311 $var = &share({}); # Same as $var = share_clone({});
313 =item is_shared VARIABLE
315 C<is_shared> checks if the specified variable is shared or not. If shared,
316 returns the variable's internal ID (similar to
317 L<refaddr()|Scalar::Util/"refaddr EXPR">). Otherwise, returns C<undef>.
319 if (is_shared($var)) {
320 print("\$var is shared\n");
322 print("\$var is not shared\n");
327 C<lock> places a lock on a variable until the lock goes out of scope. If the
328 variable is locked by another thread, the C<lock> call will block until it's
329 available. Multiple calls to C<lock> by the same thread from within
330 dynamically nested scopes are safe -- the variable will remain locked until
331 the outermost lock on the variable goes out of scope.
333 Locking a container object, such as a hash or array, doesn't lock the elements
334 of that container. For example, if a thread does a C<lock(@a)>, any other
335 thread doing a C<lock($a[12])> won't block.
337 C<lock()> follows references exactly I<one> level. C<lock(\$a)> is equivalent
338 to C<lock($a)>, while C<lock(\\$a)> is not.
340 Note that you cannot explicitly unlock a variable; you can only wait for the
341 lock to go out of scope. This is most easily accomplished by locking the
342 variable inside a block.
347 # $var is locked from here to the end of the block
350 # $var is now unlocked
352 If you need more fine-grained control over shared variable access, see
353 L<Thread::Semaphore>.
355 =item cond_wait VARIABLE
357 =item cond_wait CONDVAR, LOCKVAR
359 The C<cond_wait> function takes a B<locked> variable as a parameter, unlocks
360 the variable, and blocks until another thread does a C<cond_signal> or
361 C<cond_broadcast> for that same locked variable. The variable that
362 C<cond_wait> blocked on is relocked after the C<cond_wait> is satisfied. If
363 there are multiple threads C<cond_wait>ing on the same variable, all but one
364 will re-block waiting to reacquire the lock on the variable. (So if you're only
365 using C<cond_wait> for synchronisation, give up the lock as soon as possible).
366 The two actions of unlocking the variable and entering the blocked wait state
367 are atomic, the two actions of exiting from the blocked wait state and
368 re-locking the variable are not.
370 In its second form, C<cond_wait> takes a shared, B<unlocked> variable followed
371 by a shared, B<locked> variable. The second variable is unlocked and thread
372 execution suspended until another thread signals the first variable.
374 It is important to note that the variable can be notified even if no thread
375 C<cond_signal> or C<cond_broadcast> on the variable. It is therefore
376 important to check the value of the variable and go back to waiting if the
377 requirement is not fulfilled. For example, to pause until a shared counter
380 { lock($counter); cond_wait($count) until $counter == 0; }
382 =item cond_timedwait VARIABLE, ABS_TIMEOUT
384 =item cond_timedwait CONDVAR, ABS_TIMEOUT, LOCKVAR
386 In its two-argument form, C<cond_timedwait> takes a B<locked> variable and an
387 absolute timeout as parameters, unlocks the variable, and blocks until the
388 timeout is reached or another thread signals the variable. A false value is
389 returned if the timeout is reached, and a true value otherwise. In either
390 case, the variable is re-locked upon return.
392 Like C<cond_wait>, this function may take a shared, B<locked> variable as an
393 additional parameter; in this case the first parameter is an B<unlocked>
394 condition variable protected by a distinct lock variable.
396 Again like C<cond_wait>, waking up and reacquiring the lock are not atomic,
397 and you should always check your desired condition after this function
398 returns. Since the timeout is an absolute value, however, it does not have to
399 be recalculated with each pass:
402 my $abs = time() + 15;
403 until ($ok = desired_condition($var)) {
404 last if !cond_timedwait($var, $abs);
406 # we got it if $ok, otherwise we timed out!
408 =item cond_signal VARIABLE
410 The C<cond_signal> function takes a B<locked> variable as a parameter and
411 unblocks one thread that's C<cond_wait>ing on that variable. If more than one
412 thread is blocked in a C<cond_wait> on that variable, only one (and which one
413 is indeterminate) will be unblocked.
415 If there are no threads blocked in a C<cond_wait> on the variable, the signal
416 is discarded. By always locking before signaling, you can (with care), avoid
417 signaling before another thread has entered cond_wait().
419 C<cond_signal> will normally generate a warning if you attempt to use it on an
420 unlocked variable. On the rare occasions where doing this may be sensible, you
421 can suppress the warning with:
423 { no warnings 'threads'; cond_signal($foo); }
425 =item cond_broadcast VARIABLE
427 The C<cond_broadcast> function works similarly to C<cond_signal>.
428 C<cond_broadcast>, though, will unblock B<all> the threads that are blocked in
429 a C<cond_wait> on the locked variable, rather than only one.
435 L<threads::shared> exports a version of L<bless()|perlfunc/"bless REF"> that
436 works on shared objects such that I<blessings> propagate across threads.
438 # Create a shared 'Foo' object
439 my $foo :shared = shared_clone({});
442 # Create a shared 'Bar' object
443 my $bar :shared = shared_clone({});
446 # Put 'bar' inside 'foo'
447 $foo->{'bar'} = $bar;
449 # Rebless the objects via a thread
450 threads->create(sub {
451 # Rebless the outer object
454 # Cannot directly rebless the inner object
455 #bless($foo->{'bar'}, 'Yang');
457 # Retrieve and rebless the inner object
458 my $obj = $foo->{'bar'};
460 $foo->{'bar'} = $obj;
464 print(ref($foo), "\n"); # Prints 'Yin'
465 print(ref($foo->{'bar'}), "\n"); # Prints 'Yang'
466 print(ref($bar), "\n"); # Also prints 'Yang'
470 L<threads::shared> is designed to disable itself silently if threads are not
471 available. This allows you to write modules and packages that can be used
472 in both threaded and non-threaded applications.
474 If you want access to threads, you must C<use threads> before you
475 C<use threads::shared>. L<threads> will emit a warning if you use it after
478 =head1 BUGS AND LIMITATIONS
480 When C<share> is used on arrays, hashes, array refs or hash refs, any data
481 they contain will be lost.
483 my @arr = qw(foo bar baz);
485 # @arr is now empty (i.e., == ());
487 # Create a 'foo' object
488 my $foo = { 'data' => 99 };
492 share($foo); # Contents are now wiped out
493 print("ERROR: \$foo is empty\n")
494 if (! exists($foo->{'data'}));
496 Therefore, populate such variables B<after> declaring them as shared. (Scalar
497 and scalar refs are not affected by this problem.)
499 It is often not wise to share an object unless the class itself has been
500 written to support sharing. For example, an object's destructor may get
501 called multiple times, once for each thread's scope exit. Another danger is
502 that the contents of hash-based objects will be lost due to the above
503 mentioned limitation. See F<examples/class.pl> (in the CPAN distribution of
504 this module) for how to create a class that supports object sharing.
506 Does not support C<splice> on arrays!
508 Taking references to the elements of shared arrays and hashes does not
509 autovivify the elements, and neither does slicing a shared array/hash over
510 non-existent indices/keys autovivify the elements.
512 C<share()> allows you to C<< share($hashref->{key}) >> without giving any
513 error message. But the C<< $hashref->{key} >> is B<not> shared, causing the
514 error "locking can only be used on shared values" to occur when you attempt to
515 C<< lock($hasref->{key}) >>.
517 Using L<refaddr()|Scalar::Util/"refaddr EXPR">) is unreliable for testing
518 whether or not two shared references are equivalent (e.g., when testing for
519 circular references). Use L<is_shared()/"is_shared VARIABLE">, instead:
523 use Scalar::Util qw(refaddr);
525 # If ref is shared, use threads::shared's internal ID.
526 # Otherwise, use refaddr().
527 my $addr1 = is_shared($ref1) || refaddr($ref1);
528 my $addr2 = is_shared($ref2) || refaddr($ref2);
530 if ($addr1 == $addr2) {
531 # The refs are equivalent
534 View existing bug reports at, and submit any new bugs, problems, patches, etc.
535 to: L<http://rt.cpan.org/Public/Dist/Display.html?Name=threads-shared>
539 L<threads::shared> Discussion Forum on CPAN:
540 L<http://www.cpanforum.com/dist/threads-shared>
542 Annotated POD for L<threads::shared>:
543 L<http://annocpan.org/~JDHEDDEN/threads-shared-1.22/shared.pm>
546 L<http://code.google.com/p/threads-shared/>
548 L<threads>, L<perlthrtut>
550 L<http://www.perl.com/pub/a/2002/06/11/threads.html> and
551 L<http://www.perl.com/pub/a/2002/09/04/threads.html>
553 Perl threads mailing list:
554 L<http://lists.cpan.org/showlist.cgi?name=iThreads>
558 Artur Bergman E<lt>sky AT crucially DOT netE<gt>
560 Documentation borrowed from the old Thread.pm.
562 CPAN version produced by Jerry D. Hedden E<lt>jdhedden AT cpan DOT orgE<gt>.
566 threads::shared is released under the same license as Perl.