Thread::Queue 2.07

[p5sagit/p5-mst-13.2.git] / lib / Thread / Queue.pm

diff --git a/lib/Thread/Queue.pm b/lib/Thread/Queue.pm
index 0d9eb10..dc2b1ed 100644 (file)
--- a/lib/Thread/Queue.pm
+++ b/lib/Thread/Queue.pm
@@ -3,10 +3,10 @@ package Thread::Queue;
 use strict;
 use warnings;
 
-our $VERSION = '2.06';
+our $VERSION = '2.07';
 
 use threads::shared 0.96;
-use Scalar::Util 1.10 qw(looks_like_number);
+use Scalar::Util 1.10 qw(looks_like_number blessed reftype refaddr);
 
 # Predeclarations for internal functions
 my ($make_shared, $validate_count, $validate_index);
@@ -15,7 +15,7 @@ my ($make_shared, $validate_count, $validate_index);
 sub new
 {
     my $class = shift;
-    my @queue :shared = map { $make_shared->($_) } @_;
+    my @queue :shared = map { $make_shared->($_, {}) } @_;
     return bless(\@queue, $class);
 }
 
@@ -24,7 +24,7 @@ sub enqueue
 {
     my $queue = shift;
     lock(@$queue);
-    push(@$queue, map { $make_shared->($_) } @_)
+    push(@$queue, map { $make_shared->($_, {}) } @_)
         and cond_signal(@$queue);
 }
 
@@ -111,7 +111,7 @@ sub insert
     }
 
     # Add new items to the queue
-    push(@$queue, map { $make_shared->($_) } @_);
+    push(@$queue, map { $make_shared->($_, {}) } @_);
 
     # Add previous items back onto the queue
     push(@$queue, @tmp);
@@ -163,7 +163,7 @@ sub extract
 
 # Create a thread-shared version of a complex data structure or object
 $make_shared = sub {
-    my $item = shift;
+    my ($item, $cloned) = @_;
 
     # If not running 'threads' or already thread-shared,
     #   then just return the input item
@@ -172,22 +172,34 @@ $make_shared = sub {
 
     # Make copies of array, hash and scalar refs
     my $copy;
-    if (my $ref_type = Scalar::Util::reftype($item)) {
+    if (my $ref_type = reftype($item)) {
+        # Check for previously cloned references
+        #   (this takes care of circular refs as well)
+        my $addr = refaddr($item);
+        if (defined($addr) && exists($cloned->{$addr})) {
+            # Return the already existing clone
+            return $cloned->{$addr};
+        }
+
         # Copy an array ref
         if ($ref_type eq 'ARRAY') {
             # Make empty shared array ref
             $copy = &share([]);
+            # Add to clone checking hash
+            $cloned->{$addr} = $copy;
             # Recursively copy and add contents
-            push(@$copy, map { $make_shared->($_) } @$item);
+            push(@$copy, map { $make_shared->($_, $cloned) } @$item);
         }
 
         # Copy a hash ref
         elsif ($ref_type eq 'HASH') {
             # Make empty shared hash ref
             $copy = &share({});
+            # Add to clone checking hash
+            $cloned->{$addr} = $copy;
             # Recursively copy and add contents
             foreach my $key (keys(%{$item})) {
-                $copy->{$key} = $make_shared->($item->{$key});
+                $copy->{$key} = $make_shared->($item->{$key}, $cloned);
             }
         }
 
@@ -199,13 +211,27 @@ $make_shared = sub {
             if (Internals::SvREADONLY($$item)) {
                 Internals::SvREADONLY($$copy, 1);
             }
+            # Add to clone checking hash
+            $cloned->{$addr} = $copy;
         }
 
         # Copy of a ref of a ref
         elsif ($ref_type eq 'REF') {
-            my $tmp = $make_shared->($$item);
-            $copy = \$tmp;
-            share($copy);
+            # Special handling for $x = \$x
+            my $addr2 = refaddr($$item);
+            if ($addr2 == $addr) {
+                $copy = \$copy;
+                share($copy);
+                $cloned->{$addr} = $copy;
+            } else {
+                my $tmp;
+                $copy = \$tmp;
+                share($copy);
+                # Add to clone checking hash
+                $cloned->{$addr} = $copy;
+                # Recursively copy and add contents
+                $tmp = $make_shared->($$item, $cloned);
+            }
         }
     }
 
@@ -214,16 +240,16 @@ $make_shared = sub {
     #        other than an ordinary scalar
     return $item if (! defined($copy));
 
+    # If input item is an object, then bless the copy into the same class
+    if (my $class = blessed($item)) {
+        bless($copy, $class);
+    }
+
     # Clone READONLY flag
     if (Internals::SvREADONLY($item)) {
         Internals::SvREADONLY($copy, 1);
     }
 
-    # If input item is an object, then bless the copy into the same class
-    if (my $class = Scalar::Util::blessed($item)) {
-        bless($copy, $class);
-    }
-
     return $copy;
 };
 
@@ -265,7 +291,7 @@ Thread::Queue - Thread-safe queues
 
 =head1 VERSION
 
-This document describes Thread::Queue version 2.06
+This document describes Thread::Queue version 2.07
 
 =head1 SYNOPSIS
 
@@ -518,7 +544,7 @@ Thread::Queue Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/Thread-Queue>
 
 Annotated POD for Thread::Queue:
-L<http://annocpan.org/~JDHEDDEN/Thread-Queue-2.06/lib/Thread/Queue.pm>
+L<http://annocpan.org/~JDHEDDEN/Thread-Queue-2.07/lib/Thread/Queue.pm>
 
 Source repository:
 L<http://code.google.com/p/thread-queue/>