Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Re: getting shared_clone() functionality with earlier threads::shared?

by Anonymous Monk
on Nov 10, 2010 at 01:17 UTC ( #870462=note: print w/ replies, xml ) Need Help??


in reply to getting shared_clone() functionality with earlier threads::shared?

http://search.cpan.org/src/JDHEDDEN/threads-shared-1.34/lib/threads/shared.pm

# Create a thread-shared clone of a complex data structure or object sub shared_clone { if (@_ != 1) { require Carp; Carp::croak('Usage: shared_clone(REF)'); } return $make_shared->(shift, {}); } ### Internal Functions ### # Used by shared_clone() to recursively clone # a complex data structure or object $make_shared = sub { my ($item, $cloned) = @_; # Just return the item if: # 1. Not a ref; # 2. Already shared; or # 3. Not running 'threads'. return $item if (! ref($item) || is_shared($item) || ! $threads::t +hreads); # Check for previously cloned references # (this takes care of circular refs as well) my $addr = refaddr($item); if (exists($cloned->{$addr})) { # Return the already existing clone return $cloned->{$addr}; } # Make copies of array, hash and scalar refs and refs of refs my $copy; my $ref_type = reftype($item); # 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->($_, $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}, $cloned); } } # Copy a scalar ref elsif ($ref_type eq 'SCALAR') { $copy = \do{ my $scalar = $$item; }; share($copy); # Add to clone checking hash $cloned->{$addr} = $copy; } # Copy of a ref of a ref elsif ($ref_type eq 'REF') { # Special handling for $x = \$x if ($addr == refaddr($$item)) { $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); } } else { require Carp; Carp::croak("Unsupported ref type: ", $ref_type); } # If input item is an object, then bless the copy into the same cl +ass if (my $class = blessed($item)) { bless($copy, $class); } # Clone READONLY flag if ($ref_type eq 'SCALAR') { if (Internals::SvREADONLY($$item)) { Internals::SvREADONLY($$copy, 1) if ($] >= 5.008003); } } if (Internals::SvREADONLY($item)) { Internals::SvREADONLY($copy, 1) if ($] >= 5.008003); } return $copy; };
It is not practical for us to upgrade at this time,

Sure it is :) http://search.cpan.org/dist/threads-shared Its more practical than reinventing/debugging.... threads::shared


Comment on Re: getting shared_clone() functionality with earlier threads::shared?
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://870462]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (8)
As of 2014-09-17 06:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (61 votes), past polls