--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/02/20 20:48:00 1.10 +++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2004/06/07 16:44:54 1.24 @@ -1,7 +1,50 @@ ## --------------------------------------------------------------------------- -## $Id: Deep.pm,v 1.10 2003/02/20 20:48:00 joko Exp $ +## $Id: Deep.pm,v 1.24 2004/06/07 16:44:54 joko Exp $ ## --------------------------------------------------------------------------- ## $Log: Deep.pm,v $ +## Revision 1.24 2004/06/07 16:44:54 joko +## sub expand: Now also converts hash-keys to/from utf-8 +## +## Revision 1.23 2003/05/13 07:39:22 joko +## new option 'define' for "sub expand": set value to empty string if desired +## +## Revision 1.22 2003/05/10 17:09:18 jonen +## + added keep of empty arrays/hashes if 'expand' for php +## +## Revision 1.21 2003/04/09 07:21:56 joko +## childObj2string now inside Encode.pm, renamed to 'twingle_reference' +## +## 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) +## ## Revision 1.10 2003/02/20 20:48:00 joko ## - refactored lots of code to Data::Code::Ref ## + alternative 'deep_copy' implementation @@ -40,7 +83,7 @@ ## --------------------------------------------------------------------------- -package Data::Transform::Deep; +package Data::Mungle::Transform::Deep; use strict; use warnings; @@ -58,8 +101,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 twingle_reference ); +use Data::Mungle::Code::Ref qw( ref_slot ); sub numhash2list { my $vref = shift; @@ -129,6 +173,9 @@ } +# 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 +# TODO: Review: Could this be revamped using Clone.pm? sub expand { my $obj = shift; @@ -138,13 +185,24 @@ #print "ref: ", ref $obj, "\n"; if (ref $obj eq 'ARRAY') { - + + # if we expand for php, keep empty ARRAY + if($#$obj == -1 && $options->{childObj2string}) { + $result = $obj; + } else { IterArray @$obj, sub { 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 = twingle_reference($item); + } 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}; @@ -156,10 +214,13 @@ $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8}); $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin}); } + + $item = '' if $options->{define} and not defined $item; #push(@{$result}, $item) if $item; # use item only if not undef (TODO: make configurable via $options) push(@{$result}, $item); # use item in any case } + } } elsif (ref $obj eq 'CODE') { #print Dumper($obj); @@ -167,14 +228,31 @@ # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }" ??? } elsif (ref $obj) { - + + # if we expand for php, keep empty HASH + my @tmp = keys %$obj; + if($#tmp == -1 && $options->{childObj2string}) { + $result = $obj; + } else { IterHash %$obj, sub { + my $key = $_[0]; my $item; - + + # conversions/encodings + $key = latin_to_utf8_scalar($key) if ($key && $options->{utf8}); + $key = utf8_to_latin_scalar($key) if ($key && $options->{to_latin}); + # 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") && !(ref $_[1] eq "Set::Object")) { + $item = twingle_reference($item); + } 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}; @@ -186,9 +264,12 @@ $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8}); $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin}); } + + $item = '' if $options->{define} and not defined $item; #$result->{$_[0]} = $item if $item; # use item only if not undef (TODO: make configurable via $options) - $result->{$_[0]} = $item; # use item in any case + $result->{$key} = $item; # use item in any case } + } } else { #die ("not a reference!"); @@ -198,7 +279,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}; @@ -258,7 +339,7 @@ sub merge_to { _hash2object(@_); # TODO: - # re-implement using CPAN's "Iterate". + # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge. } @@ -275,7 +356,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: @@ -441,58 +522,10 @@ # ACK's go to Andrew Pitonyak # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org) # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html -sub deep_copy2 { - - # if not defined then return it - return undef if $#_ < 0 || !defined( $_[0] ); - - # if not a reference then return the parameter - return $_[0] if !ref( $_[0] ); - my $obj = shift; - if ( UNIVERSAL::isa( $obj, 'SCALAR' ) ) { - my $temp = deep_copy2($$obj); - return \$temp; - } - elsif ( UNIVERSAL::isa( $obj, 'HASH' ) ) { - my $temp_hash = {}; - foreach my $key ( keys %$obj ) { - if ( !defined( $obj->{$key} ) || !ref( $obj->{$key} ) ) { - $temp_hash->{$key} = $obj->{$key}; - } - else { - $temp_hash->{$key} = deep_copy2( $obj->{$key} ); - } - } - return $temp_hash; - } - elsif ( UNIVERSAL::isa( $obj, 'ARRAY' ) ) { - my $temp_array = []; - foreach my $array_val (@$obj) { - if ( !defined($array_val) || !ref($array_val) ) { - push ( @$temp_array, $array_val ); - } - else { - push ( @$temp_array, deep_copy2($array_val) ); - } - } - return $temp_array; - } - - # ?? I am uncertain about this one - elsif ( UNIVERSAL::isa( $obj, 'REF' ) ) { - my $temp = deep_copy2($$obj); - return \$temp; - } - - # I guess that it is either CODE, GLOB or LVALUE - else { - return $obj; - } -} - sub deep_copy { - deep_copy2(@_); + Pitonyak::DeepCopy::deep_copy(@_); } + 1; __END__