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 |
|