package Pitonyak::DeepCopy; #************************************************************ =head1 NAME Pitonyak::DeepCopy - Copy an object with new copies, even if it contains references. =head1 SYNOPSIS use Pitonyak::DeepCopy; my $new_hash_ref = Pitonyak::DeepCopy::deep_copy(\%original_hash); =head1 DESCRIPTION I ran into problems when I had a hash that contained another hash reference. I copied the elements from one hash to another and then changed the values in the referenced hash. Confused? Okay, here is what the code looked like. C 2, 'ref' =E {'E' =E 1}, );> I then made a new hash with all the same values in C<%hash_ref> but this included a reference to the hash because my code included C<$new_hash{'ref'} = $old_hash.{'ref'};> I then created this method so now I can do: C =head1 COPYRIGHT Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 Modification History =head2 September 01, 2002 Version 1.00 First release =cut require Exporter; $VERSION = '1.00'; @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(deep_copy); use Carp; use strict; sub deep_copy { # if not defined then return it return undef if $#_ < 0 || !defined( $_[0] ); # if not a reference then return the parameter return $_[0] if !ref( $_[0] ); my $obj = shift; if ( UNIVERSAL::isa( $obj, 'SCALAR' ) ) { my $temp = deepcopy($$obj); return \$temp; } elsif ( UNIVERSAL::isa( $obj, 'HASH' ) ) { my $temp_hash = {}; foreach my $key ( keys %$obj ) { if ( !defined( $obj->{$key} ) || !ref( $obj->{$key} ) ) { $temp_hash->{$key} = $obj->{$key}; } else { $temp_hash->{$key} = deep_copy( $obj->{$key} ); } } return $temp_hash; } elsif ( UNIVERSAL::isa( $obj, 'ARRAY' ) ) { my $temp_array = []; foreach my $array_val (@$obj) { if ( !defined($array_val) || !ref($array_val) ) { push ( @$temp_array, $array_val ); } else { push ( @$temp_array, deep_copy($array_val) ); } } return $temp_array; } # ?? I am uncertain about this one elsif ( UNIVERSAL::isa( $obj, 'REF' ) ) { my $temp = deepcopy($$obj); return \$temp; } # I guess that it is either CODE, GLOB or LVALUE else { return $obj; } } #************************************************************ =pod =head1 COPYRIGHT Copyright 1998-2002, Andrew Pitonyak (perlboy@pitonyak.org) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 Modification History =head2 March 13, 1998 Version 1.00 First release =head2 September 10, 2002 Version 1.01 Changed internal documentation to POD documentation. Added parameter checking. =cut #************************************************************ 1;