| 1 |
package Pitonyak::DeepCopy; |
| 2 |
|
| 3 |
#************************************************************ |
| 4 |
|
| 5 |
=head1 NAME |
| 6 |
|
| 7 |
Pitonyak::DeepCopy - Copy an object with new copies, even if it contains references. |
| 8 |
|
| 9 |
=head1 SYNOPSIS |
| 10 |
|
| 11 |
use Pitonyak::DeepCopy; |
| 12 |
|
| 13 |
my $new_hash_ref = Pitonyak::DeepCopy::deep_copy(\%original_hash); |
| 14 |
|
| 15 |
=head1 DESCRIPTION |
| 16 |
|
| 17 |
I ran into problems when I had a hash that contained another hash reference. |
| 18 |
I copied the elements from one hash to another and then changed the values in |
| 19 |
the referenced hash. Confused? Okay, here is what the code looked like. |
| 20 |
|
| 21 |
C<my %old_hash = ('val' =E<gt> 2, 'ref' =E<gt> {'E' =E<gt> 1}, );> |
| 22 |
|
| 23 |
I then made a new hash with all the same values in C<%hash_ref> but this included a reference |
| 24 |
to the hash because my code included C<$new_hash{'ref'} = $old_hash.{'ref'};> |
| 25 |
|
| 26 |
I then created this method so now I can do: |
| 27 |
|
| 28 |
C<my $hash_ref = Pitonyak::DeepCopy::deep_copy(\%pld_hash);> |
| 29 |
|
| 30 |
|
| 31 |
=head1 COPYRIGHT |
| 32 |
|
| 33 |
Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org) |
| 34 |
|
| 35 |
This library is free software; you can redistribute it and/or |
| 36 |
modify it under the same terms as Perl itself. |
| 37 |
|
| 38 |
=head1 Modification History |
| 39 |
|
| 40 |
=head2 September 01, 2002 |
| 41 |
|
| 42 |
Version 1.00 First release |
| 43 |
|
| 44 |
=cut |
| 45 |
|
| 46 |
require Exporter; |
| 47 |
$VERSION = '1.00'; |
| 48 |
@ISA = qw(Exporter); |
| 49 |
@EXPORT = qw(); |
| 50 |
@EXPORT_OK = qw(deep_copy); |
| 51 |
|
| 52 |
use Carp; |
| 53 |
use strict; |
| 54 |
|
| 55 |
sub deep_copy { |
| 56 |
|
| 57 |
# if not defined then return it |
| 58 |
return undef if $#_ < 0 || !defined( $_[0] ); |
| 59 |
|
| 60 |
# if not a reference then return the parameter |
| 61 |
return $_[0] if !ref( $_[0] ); |
| 62 |
my $obj = shift; |
| 63 |
if ( UNIVERSAL::isa( $obj, 'SCALAR' ) ) { |
| 64 |
my $temp = deepcopy($$obj); |
| 65 |
return \$temp; |
| 66 |
} |
| 67 |
elsif ( UNIVERSAL::isa( $obj, 'HASH' ) ) { |
| 68 |
my $temp_hash = {}; |
| 69 |
foreach my $key ( keys %$obj ) { |
| 70 |
if ( !defined( $obj->{$key} ) || !ref( $obj->{$key} ) ) { |
| 71 |
$temp_hash->{$key} = $obj->{$key}; |
| 72 |
} |
| 73 |
else { |
| 74 |
$temp_hash->{$key} = deep_copy( $obj->{$key} ); |
| 75 |
} |
| 76 |
} |
| 77 |
return $temp_hash; |
| 78 |
} |
| 79 |
elsif ( UNIVERSAL::isa( $obj, 'ARRAY' ) ) { |
| 80 |
my $temp_array = []; |
| 81 |
foreach my $array_val (@$obj) { |
| 82 |
if ( !defined($array_val) || !ref($array_val) ) { |
| 83 |
push ( @$temp_array, $array_val ); |
| 84 |
} |
| 85 |
else { |
| 86 |
push ( @$temp_array, deep_copy($array_val) ); |
| 87 |
} |
| 88 |
} |
| 89 |
return $temp_array; |
| 90 |
} |
| 91 |
|
| 92 |
# ?? I am uncertain about this one |
| 93 |
elsif ( UNIVERSAL::isa( $obj, 'REF' ) ) { |
| 94 |
my $temp = deepcopy($$obj); |
| 95 |
return \$temp; |
| 96 |
} |
| 97 |
|
| 98 |
# I guess that it is either CODE, GLOB or LVALUE |
| 99 |
else { |
| 100 |
return $obj; |
| 101 |
} |
| 102 |
} |
| 103 |
|
| 104 |
#************************************************************ |
| 105 |
|
| 106 |
=pod |
| 107 |
|
| 108 |
=head1 COPYRIGHT |
| 109 |
|
| 110 |
Copyright 1998-2002, Andrew Pitonyak (perlboy@pitonyak.org) |
| 111 |
|
| 112 |
This library is free software; you can redistribute it and/or |
| 113 |
modify it under the same terms as Perl itself. |
| 114 |
|
| 115 |
=head1 Modification History |
| 116 |
|
| 117 |
=head2 March 13, 1998 |
| 118 |
|
| 119 |
Version 1.00 First release |
| 120 |
|
| 121 |
=head2 September 10, 2002 |
| 122 |
|
| 123 |
Version 1.01 Changed internal documentation to POD documentation. Added parameter checking. |
| 124 |
|
| 125 |
=cut |
| 126 |
|
| 127 |
#************************************************************ |
| 128 |
|
| 129 |
1; |
| 130 |
|
Parent Directory
| 
Revision Log
