--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2002/12/05 13:56:49 1.4 +++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2002/12/23 11:27:53 1.6 @@ -1,8 +1,14 @@ ############################################## # -# $Id: Deep.pm,v 1.4 2002/12/05 13:56:49 joko Exp $ +# $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 @@ -256,7 +262,7 @@ #my $obj = $self->getObject($oid); # mix changes into fresh object and save it back - hash2object_traverse_mixin($object, $data); + hash2object_traverse_mixin($object, $data, 0, $options); # done in core mixin function? #$self->{storage}->update($obj); @@ -283,6 +289,7 @@ my $object = shift; my $data = shift; my $bool_recursion = shift; + my $options = shift; # clear our key - stack if we are called from user-code (non-recursively) @indexstack = () if (!$bool_recursion); @@ -300,18 +307,25 @@ # print STDERR "===", "reftype: ", attributes::reftype($obj), "\n"; + my @fields; # loop through fields of object (Tangram-object) - foreach (keys %{$object}) { + @fields = keys %{$object}; + + # loop through fields of to.be.injected-data (arbitrary Perl-data-structure) + @fields = keys %{$data} if $options->{init}; +# @fields = keys %{$data} if $options->{mixin}; + + foreach (@fields) { push @indexstack, $_; # determine type of object my $ref = ref $object->{$_}; # print STDERR "attrname: $_ ATTRref: $ref", "\n"; if ($ref) { - hash2object_traverse_mixin($object->{$_}, $data, 1); + hash2object_traverse_mixin($object->{$_}, $data, 1, $options); } else { my $val = getStructSlotByStringyAddress($data, \@indexstack); - $object->{$_} = $val; + $object->{$_} = $val if defined $val; } pop @indexstack; } @@ -342,10 +356,11 @@ push @indexstack, $i; my $ref = ref $_; # print STDERR "attrname: $_ ATTRref: $ref", "\n"; - if ($ref && $_) { - hash2object_traverse_mixin($_, $data, 1); +# if ($ref && $_) { + if ($ref) { + hash2object_traverse_mixin($_, $data, 1, $options); } else { - $object->[$i] = $_; + $object->[$i] = $_ if defined $_; } pop @indexstack; $i++; @@ -356,6 +371,7 @@ # this function seems to do similar stuff like these below (refexpr2perlref & co.) +# TODO: maybe this mechanism can be replaced completely through some nice module from CPAN .... ? ;-) sub getStructSlotByStringyAddress { my $var = shift; my $indexstack_ref = shift;