2 |
## $Id$ |
## $Id$ |
3 |
## --------------------------------------------------------------------------- |
## --------------------------------------------------------------------------- |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.20 2003/04/04 17:31:23 joko |
6 |
|
## minor update to 'childObj2string' |
7 |
|
## |
8 |
|
## Revision 1.19 2003/03/28 03:11:25 jonen |
9 |
|
## + bugfix |
10 |
|
## |
11 |
|
## Revision 1.18 2003/03/28 03:07:26 jonen |
12 |
|
## + minor changes |
13 |
|
## |
14 |
|
## Revision 1.17 2003/03/27 15:17:07 joko |
15 |
|
## namespace fixes for Data::Mungle::* |
16 |
|
## |
17 |
|
## Revision 1.16 2003/03/27 15:04:52 joko |
18 |
|
## minor update: comment |
19 |
|
## |
20 |
|
## Revision 1.15 2003/02/27 14:39:48 jonen |
21 |
|
## + fixed bug at _hash2object() |
22 |
|
## |
23 |
|
## Revision 1.14 2003/02/22 17:13:55 jonen |
24 |
|
## + added function 'childObject2string()' to encode 'child'-references to option related string |
25 |
|
## + use new option at 'expand()' for replacing 'childObject2string' |
26 |
|
## |
27 |
|
## Revision 1.13 2003/02/21 01:48:50 joko |
28 |
|
## renamed core function |
29 |
|
## |
30 |
|
## Revision 1.12 2003/02/20 22:45:19 joko |
31 |
|
## fix regarding new deep_copy |
32 |
|
## |
33 |
## Revision 1.11 2003/02/20 21:13:54 joko |
## Revision 1.11 2003/02/20 21:13:54 joko |
34 |
## - removed implementation of deep_copy2 - get this from the Pitonyak namespace (now cloned to repository) |
## - removed implementation of deep_copy2 - get this from the Pitonyak namespace (now cloned to repository) |
35 |
## |
## |
71 |
## --------------------------------------------------------------------------- |
## --------------------------------------------------------------------------- |
72 |
|
|
73 |
|
|
74 |
package Data::Transform::Deep; |
package Data::Mungle::Transform::Deep; |
75 |
|
|
76 |
use strict; |
use strict; |
77 |
use warnings; |
use warnings; |
89 |
use Data::Dumper; |
use Data::Dumper; |
90 |
use Iterate; |
use Iterate; |
91 |
|
|
92 |
use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar ); |
use Pitonyak::DeepCopy; |
93 |
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 ); |
94 |
|
use Data::Mungle::Code::Ref qw( ref_slot ); |
95 |
|
|
96 |
sub numhash2list { |
sub numhash2list { |
97 |
my $vref = shift; |
my $vref = shift; |
161 |
} |
} |
162 |
|
|
163 |
|
|
164 |
|
# convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML |
165 |
|
# but still using the known latin locale stuff |
166 |
sub expand { |
sub expand { |
167 |
|
|
168 |
my $obj = shift; |
my $obj = shift; |
177 |
my $item; |
my $item; |
178 |
# if current item is a reference ... |
# if current item is a reference ... |
179 |
if (ref $_[0]) { |
if (ref $_[0]) { |
180 |
# ... expand structure recursively |
$item = $_[0]; |
181 |
$item = expand($_[0], $options); |
# if $options->{childObj2string} is TRUE or STRING don't expand referenced object, |
182 |
|
# instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> ) |
183 |
|
if ($item && $options->{childObj2string}) { |
184 |
|
$item = childObj2string($item, $options->{childObj2string}); |
185 |
|
} else { |
186 |
|
# ... expand structure recursively |
187 |
|
$item = expand($_[0], $options); |
188 |
|
} |
189 |
# destroy item via seperate callback method (a POST) if requested |
# destroy item via seperate callback method (a POST) if requested |
190 |
#$options->{cb}->{destroy}->($_[0]) if $options->{destroy}; |
#$options->{cb}->{destroy}->($_[0]) if $options->{destroy}; |
191 |
|
|
214 |
|
|
215 |
# if current item is a reference ... |
# if current item is a reference ... |
216 |
if (ref $_[1]) { |
if (ref $_[1]) { |
217 |
# ... expand structure recursively |
$item = $_[1]; |
218 |
$item = expand($_[1], $options); |
# if $options->{childObj2string} is TRUE or STRING don't expand referenced object, |
219 |
|
# instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> ) |
220 |
|
if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) { |
221 |
|
$item = childObj2string($item, $options->{childObj2string}); |
222 |
|
} else { |
223 |
|
# ... expand structure recursively |
224 |
|
$item = expand($_[1], $options); |
225 |
|
} |
226 |
# destroy item via seperate callback method (a POST) if requested |
# destroy item via seperate callback method (a POST) if requested |
227 |
#$options->{cb}->{destroy}->($_[1]) if $options->{destroy}; |
#$options->{cb}->{destroy}->($_[1]) if $options->{destroy}; |
228 |
|
|
246 |
|
|
247 |
# convert all values to utf8 (inside complex struct) |
# convert all values to utf8 (inside complex struct) |
248 |
# now done in core-item-callbacks via Greg London's "Iterate" from CPAN |
# now done in core-item-callbacks via Greg London's "Iterate" from CPAN |
249 |
# var2utf8($result) if ($options->{utf8}); |
# latin_to_utf8($result) if ($options->{utf8}); |
250 |
|
|
251 |
# destroy persistent object from memory to be sure to get a fresh one next time |
# destroy persistent object from memory to be sure to get a fresh one next time |
252 |
#undef $obj if $options->{destroy}; |
#undef $obj if $options->{destroy}; |
306 |
sub merge_to { |
sub merge_to { |
307 |
_hash2object(@_); |
_hash2object(@_); |
308 |
# TODO: |
# TODO: |
309 |
# re-implement using CPAN's "Iterate". |
# re-implement using CPAN's "Iterate" and/or a modified Hash::Merge. |
310 |
} |
} |
311 |
|
|
312 |
|
|
323 |
numhash2list($data) if ($options->{php}); |
numhash2list($data) if ($options->{php}); |
324 |
|
|
325 |
# utf8-conversion/-encoding (essential for I18N) |
# utf8-conversion/-encoding (essential for I18N) |
326 |
var_utf2iso($data) if ($options->{utf8}); |
utf8_to_latin($data) if ($options->{utf8}); |
327 |
|
|
328 |
# get fresh object from database |
# get fresh object from database |
329 |
# todo: |
# todo: |
490 |
# Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org) |
# Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org) |
491 |
# please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html |
# please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html |
492 |
sub deep_copy { |
sub deep_copy { |
493 |
Pitonyak::deep_copy(@_); |
Pitonyak::DeepCopy::deep_copy(@_); |
494 |
|
} |
495 |
|
|
496 |
|
|
497 |
|
# encodes object-references to serialized string representations |
498 |
|
# made up of: |
499 |
|
# - 'o_<classname>_<ref type>_<guid>'??? |
500 |
|
# - 'o_{guid}_{classname}'!!! |
501 |
|
sub childObj2string { |
502 |
|
my $obj = shift; |
503 |
|
my $option = shift; |
504 |
|
my $string = 'n/a'; |
505 |
|
|
506 |
|
if ($option == 1) { |
507 |
|
if ((my $classname = ref $obj) && (my $guid = $obj->{guid})) { |
508 |
|
$string = join('_', 'o', $guid, $classname); |
509 |
|
} |
510 |
|
} |
511 |
|
|
512 |
|
return $string; |
513 |
} |
} |
514 |
|
|
515 |
|
|
516 |
1; |
1; |
517 |
__END__ |
__END__ |