--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2002/12/23 11:27:53 1.6 +++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/01/19 03:26:59 1.7 @@ -1,31 +1,33 @@ -############################################## -# -# $Id: Deep.pm,v 1.6 2002/12/23 11:27:53 jonen Exp $ -# -# $Log: Deep.pm,v $ -# Revision 1.6 2002/12/23 11:27:53 jonen -# + changed behavior WATCH! -# -# Revision 1.5 2002/12/16 19:57:54 joko -# + option 'init' -# -# Revision 1.4 2002/12/05 13:56:49 joko -# - var_deref -# + expand - more sophisticated dereferencing with callbacks using Iterate -# -# Revision 1.3 2002/12/03 05:34:55 joko -# + bugfix: now utilizing var_utf2iso from Data::Transform::Encode -# -# Revision 1.2 2002/12/01 04:44:07 joko -# + code from Data::Transform::OO -# -# Revision 1.1 2002/11/29 04:49:20 joko -# + initial check-in -# -# Revision 1.1 2002/10/10 03:26:00 cvsjoko -# + new -# -############################################## +## --------------------------------------------------------------------------- +## $Id: Deep.pm,v 1.7 2003/01/19 03:26:59 joko Exp $ +## --------------------------------------------------------------------------- +## $Log: Deep.pm,v $ +## Revision 1.7 2003/01/19 03:26:59 joko +## + added 'sub deep_copy' - refactored from libp +## + add 'sub merge' - exported from CPAN's 'Hash::Merge' +## +## Revision 1.6 2002/12/23 11:27:53 jonen +## + changed behavior WATCH! +## +## Revision 1.5 2002/12/16 19:57:54 joko +## + option 'init' +## +## Revision 1.4 2002/12/05 13:56:49 joko +## - var_deref +## + expand - more sophisticated dereferencing with callbacks using Iterate +## +## Revision 1.3 2002/12/03 05:34:55 joko +## + bugfix: now utilizing var_utf2iso from Data::Transform::Encode +## +## Revision 1.2 2002/12/01 04:44:07 joko +## + code from Data::Transform::OO +## +## Revision 1.1 2002/11/29 04:49:20 joko +## + initial check-in +## +## Revision 1.1 2002/10/10 03:26:00 cvsjoko +## + new +## --------------------------------------------------------------------------- package Data::Transform::Deep; @@ -42,6 +44,8 @@ &hash2object &refexpr2perlref &expand + &deep_copy + &merge ); # &var_deref # &getStructSlotByStringyAddress @@ -49,7 +53,9 @@ use attributes; use Data::Dumper; use Data::Transform::Encode qw( var_utf2iso var2utf8 scalar2utf8 ); -use libp qw( deep_copy ); + +use Hash::Merge qw( merge ); +#use libp qw( deep_copy ); use Iterate; sub var_NumericalHashToArray { @@ -316,16 +322,26 @@ # @fields = keys %{$data} if $options->{mixin}; foreach (@fields) { - push @indexstack, $_; + my $field = $_; + push @indexstack, $field; # determine type of object - my $ref = ref $object->{$_}; + my $ref = ref $object->{$field}; # print STDERR "attrname: $_ ATTRref: $ref", "\n"; if ($ref) { - hash2object_traverse_mixin($object->{$_}, $data, 1, $options); + hash2object_traverse_mixin($object->{$field}, $data, 1, $options); } else { my $val = getStructSlotByStringyAddress($data, \@indexstack); - $object->{$_} = $val if defined $val; + +print Dumper($options); + my $field_target = $field; + if (my $pattern = $options->{pattern_strip_key}) { + print "pattern: $pattern", "\n"; + $field_target =~ s/$pattern//; + print "field: $field_target", "\n"; + } + + $object->{$field_target} = $val if defined $val; } pop @indexstack; } @@ -455,4 +471,19 @@ return (join('->', @parts_capsule), \@parts_pure); } +# ACK's go to ... +sub deep_copy { + my $this = shift; + if (not ref $this) { + $this; + } elsif (ref $this eq "ARRAY") { + [map deep_copy($_), @$this]; + } elsif (ref $this eq "HASH") { + +{map { $_ => deep_copy($this->{$_}) } keys %$this}; + } elsif (ref $this eq "CODE") { + $this; + #} else { die "deep_copy asks: what type is $this?" } + } else { print "deep_copy asks: what type is $this?", "\n"; } +} + 1;