libs/Pitonyak/DeepCopy.pm

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<my %old_hash = ('val' =E<gt> 2, 'ref' =E<gt> {'E' =E<gt> 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<my $hash_ref = Pitonyak::DeepCopy::deep_copy(\%pld_hash);>


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

1	joko	1.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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26