--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/02/20 21:13:54 1.11 +++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/04/04 17:31:23 1.20 @@ -1,7 +1,35 @@ ## --------------------------------------------------------------------------- -## $Id: Deep.pm,v 1.11 2003/02/20 21:13:54 joko Exp $ +## $Id: Deep.pm,v 1.20 2003/04/04 17:31:23 joko Exp $ ## --------------------------------------------------------------------------- ## $Log: Deep.pm,v $ +## Revision 1.20 2003/04/04 17:31:23 joko +## minor update to 'childObj2string' +## +## Revision 1.19 2003/03/28 03:11:25 jonen +## + bugfix +## +## Revision 1.18 2003/03/28 03:07:26 jonen +## + minor changes +## +## Revision 1.17 2003/03/27 15:17:07 joko +## namespace fixes for Data::Mungle::* +## +## Revision 1.16 2003/03/27 15:04:52 joko +## minor update: comment +## +## Revision 1.15 2003/02/27 14:39:48 jonen +## + fixed bug at _hash2object() +## +## 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 +## ## Revision 1.11 2003/02/20 21:13:54 joko ## - removed implementation of deep_copy2 - get this from the Pitonyak namespace (now cloned to repository) ## @@ -43,7 +71,7 @@ ## --------------------------------------------------------------------------- -package Data::Transform::Deep; +package Data::Mungle::Transform::Deep; use strict; use warnings; @@ -61,8 +89,9 @@ use Data::Dumper; use Iterate; -use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar ); -use Data::Code::Ref qw( ref_slot ); +use Pitonyak::DeepCopy; +use Data::Mungle::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar ); +use Data::Mungle::Code::Ref qw( ref_slot ); sub numhash2list { my $vref = shift; @@ -132,6 +161,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; @@ -146,8 +177,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}; @@ -176,8 +214,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}; @@ -201,7 +246,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}; @@ -261,7 +306,7 @@ sub merge_to { _hash2object(@_); # TODO: - # re-implement using CPAN's "Iterate". + # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge. } @@ -278,7 +323,7 @@ numhash2list($data) if ($options->{php}); # utf8-conversion/-encoding (essential for I18N) - var_utf2iso($data) if ($options->{utf8}); + utf8_to_latin($data) if ($options->{utf8}); # get fresh object from database # todo: @@ -445,8 +490,28 @@ # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org) # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html sub deep_copy { - Pitonyak::deep_copy(@_); + Pitonyak::DeepCopy::deep_copy(@_); +} + + +# encodes object-references to serialized string representations +# made up of: +# - 'o___'??? +# - 'o_{guid}_{classname}'!!! +sub childObj2string { + my $obj = shift; + my $option = shift; + my $string = 'n/a'; + + if ($option == 1) { + if ((my $classname = ref $obj) && (my $guid = $obj->{guid})) { + $string = join('_', 'o', $guid, $classname); + } + } + + return $string; } + 1; __END__