Here's a version of my own kludgey deep copy. -Updated to use our mythical
->CLONE method, and watch for circular references...
our %SEEN = ();
our $DEPTH = 0;
%a = (a => 1, b => 2, c => [{a => 1, b => [1,2,3]}, 1, 2, 3]);
*b = dcopy(\%a);
sub dcopy { # Dereference and return a deep copy of whatever's passed
our %SEEN;
local $_ = ref($_[0]) or return $_[0];
exists $SEEN{$_} and return $SEEN{$_};
$DEPTH++;
my $rval =
/^HASH$/ ? {map {dcopy($_)} (%{$_[0]})}
: /^ARRAY$/ ? [map {dcopy($_)} @{$_[0]} ]
: /^SCALAR$/ ? \${$_[0]}
: /^FORMAT$/ ? $_[0] # Shallow copy until we figure out
: /^Regexp$/ ? $_[0] # B.pm and Class::Tom show the way
: /^REF$/ ? $_[0] # how to deep copy these. Note:
: /^IO$/ ? $_[0] # "
: /^GLOB$/ ? $_[0] # "
: /^CODE$/ ? $_[0] # " (B::Deparse)
: $_[0]->CLONE;
--$DEPTH
and $SEEN{$_} = ref($rval)
or $SEEN = ();
$rval;
}
> (/^$/ || /^CODE$/) && return $obj;
> /^SCALAR|REF$/ && return \clone $$obj;
> /^ARRAY$/ && return [ map clone($_), @$obj ];
> /^HASH$/ && return { map {$_, clone $obj->{$_}}
> keys %$obj };
>
> TODO: behavior for C<GLOB>, C<REGEX>, and C<LVALUE>.
I would like deep copying to include copying CODE. It would be useful for
implementing object methods...
> =head2 Filehandles
>
> If C<clone> encounters an C<IO::Handle>, its default behavior
> will be to make a copy of the filehandle (debatable: perhaps
> the default should be to throw an exception) unless a C<CALLBACK>
> function was specified
Doesn't this fall under $obj->CLONE?
Speaking of UNIVERSAL::CLONE is it really more complicated than a special
case of the above dcopy subroutine? Hmm... I guess I'm not covering tied
variables...
our %SEEN = ();
our $DEPTH = 0;
sub CLONE { # Dereference and return a deep copy of whatever's passed
our %SEEN;
my $ref = ref($_[0]) or return $_[0];
exists $SEEN{$_} and return $SEEN{$_};
$DEPTH++;
my ($a,$z) = (qr/(^|^.*?=)/, qr/\(.*?\)$/);
my $r =
($_[0] =~ /${a}HASH$z/) ? {map {dcopy($_)} (%{$_[1]})}
: ($_[0] =~ /${a}ARRAY$z/) ? [map {dcopy($_)} @{$_[1]} ]
: ($_[0] =~ /${a}SCALAR$z/) ? \${$_[1]}
: ($_[0] =~ /${a}FORMAT$z/) ? $_[0]
: ($_[0] =~ /${a}CODE$z/) ? $_[0]
: ($_[0] =~ /${a}Regexp$z/) ? $_[0]
: ($_[0] =~ /${a}REF$z/) ? $_[0]
: ($_[0] =~ /${a}IO$z/) ? $_[0]
: ($_[0] =~ /${a}GLOB$z/) ? $_[0]
: croak "unknown data type $_[0] $ref";
--$DEPTH
and $SEEN{$_} = ref($rval)
or $SEEN = ();
$ref !~ /^(HASH|ARRAY|SCALAR|GLOB|FORMAT|CODE|Regexp|REF|IO)$/
and bless $r, $ref
or $r;
}
