# 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;
};
[download]