--- 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/16 19:57:54 1.5 @@ -1,8 +1,11 @@ ############################################## # -# $Id: Deep.pm,v 1.4 2002/12/05 13:56:49 joko Exp $ +# $Id: Deep.pm,v 1.5 2002/12/16 19:57:54 joko Exp $ # # $Log: Deep.pm,v $ +# 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 +259,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 +286,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,15 +304,21 @@ # 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}; + + 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; @@ -343,7 +353,7 @@ my $ref = ref $_; # print STDERR "attrname: $_ ATTRref: $ref", "\n"; if ($ref && $_) { - hash2object_traverse_mixin($_, $data, 1); + hash2object_traverse_mixin($_, $data, 1, $options); } else { $object->[$i] = $_; } @@ -356,6 +366,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;