--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/02/20 22:45:19 1.12 +++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/02/22 17:13:55 1.14 @@ -1,7 +1,14 @@ ## --------------------------------------------------------------------------- -## $Id: Deep.pm,v 1.12 2003/02/20 22:45:19 joko Exp $ +## $Id: Deep.pm,v 1.14 2003/02/22 17:13:55 jonen Exp $ ## --------------------------------------------------------------------------- ## $Log: Deep.pm,v $ +## Revision 1.14 2003/02/22 17:13:55 jonen +## + added function 'childObject2string()' to encode 'child'-references to option related string +## + use new option at 'expand()' for replacing 'childObject2string' +## +## Revision 1.13 2003/02/21 01:48:50 joko +## renamed core function +## ## Revision 1.12 2003/02/20 22:45:19 joko ## fix regarding new deep_copy ## @@ -136,6 +143,8 @@ } +# convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML +# but still using the known latin locale stuff sub expand { my $obj = shift; @@ -150,8 +159,15 @@ my $item; # if current item is a reference ... if (ref $_[0]) { - # ... expand structure recursively - $item = expand($_[0], $options); + $item = $_[0]; + # if $options->{childObj2string} is TRUE or STRING don't expand referenced object, + # instead replace it by per option choosed string (default: o___ ) + if ($item && $options->{childObj2string}) { + $item = childObj2string($item, $options->{childObj2string}); + } else { + # ... expand structure recursively + $item = expand($_[0], $options); + } # destroy item via seperate callback method (a POST) if requested #$options->{cb}->{destroy}->($_[0]) if $options->{destroy}; @@ -180,8 +196,15 @@ # if current item is a reference ... if (ref $_[1]) { - # ... expand structure recursively - $item = expand($_[1], $options); + $item = $_[1]; + # if $options->{childObj2string} is TRUE or STRING don't expand referenced object, + # instead replace it by per option choosed string (default: o___ ) + if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) { + $item = childObj2string($item, $options->{childObj2string}); + } else { + # ... expand structure recursively + $item = expand($_[1], $options); + } # destroy item via seperate callback method (a POST) if requested #$options->{cb}->{destroy}->($_[1]) if $options->{destroy}; @@ -205,7 +228,7 @@ # convert all values to utf8 (inside complex struct) # now done in core-item-callbacks via Greg London's "Iterate" from CPAN - # var2utf8($result) if ($options->{utf8}); + # latin_to_utf8($result) if ($options->{utf8}); # destroy persistent object from memory to be sure to get a fresh one next time #undef $obj if $options->{destroy}; @@ -453,5 +476,17 @@ } +sub childObj2string { + my $obj = shift; + my $option = shift; + my $classname = ref $obj; + + if($option == 1) { + my $string = "o_" . $classname . "_" .$obj->{guid}; + return $string; + } +} + + 1; __END__