--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/02/22 17:13:55 1.14 +++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm 2003/05/10 17:09:18 1.22 @@ -1,7 +1,31 @@ ## --------------------------------------------------------------------------- -## $Id: Deep.pm,v 1.14 2003/02/22 17:13:55 jonen Exp $ +## $Id: Deep.pm,v 1.22 2003/05/10 17:09:18 jonen Exp $ ## --------------------------------------------------------------------------- ## $Log: Deep.pm,v $ +## 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' @@ -53,7 +77,7 @@ ## --------------------------------------------------------------------------- -package Data::Transform::Deep; +package Data::Mungle::Transform::Deep; use strict; use warnings; @@ -72,8 +96,8 @@ use Iterate; use Pitonyak::DeepCopy; -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 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; @@ -154,7 +178,11 @@ #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 ... @@ -163,7 +191,7 @@ # 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}); + $item = twingle_reference($item); } else { # ... expand structure recursively $item = expand($_[0], $options); @@ -183,6 +211,7 @@ push(@{$result}, $item); # use item in any case } + } } elsif (ref $obj eq 'CODE') { #print Dumper($obj); @@ -190,7 +219,12 @@ # 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 $item; @@ -199,8 +233,8 @@ $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}); + 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); @@ -219,6 +253,7 @@ #$result->{$_[0]} = $item if $item; # use item only if not undef (TODO: make configurable via $options) $result->{$_[0]} = $item; # use item in any case } + } } else { #die ("not a reference!"); @@ -288,7 +323,7 @@ sub merge_to { _hash2object(@_); # TODO: - # re-implement using CPAN's "Iterate". + # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge. } @@ -305,7 +340,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: @@ -476,17 +511,5 @@ } -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__