2 |
## $Id$ |
## $Id$ |
3 |
## --------------------------------------------------------------------------- |
## --------------------------------------------------------------------------- |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.18 2003/03/28 03:07:26 jonen |
6 |
|
## + minor changes |
7 |
|
## |
8 |
|
## Revision 1.17 2003/03/27 15:17:07 joko |
9 |
|
## namespace fixes for Data::Mungle::* |
10 |
|
## |
11 |
|
## Revision 1.16 2003/03/27 15:04:52 joko |
12 |
|
## minor update: comment |
13 |
|
## |
14 |
|
## Revision 1.15 2003/02/27 14:39:48 jonen |
15 |
|
## + fixed bug at _hash2object() |
16 |
|
## |
17 |
|
## Revision 1.14 2003/02/22 17:13:55 jonen |
18 |
|
## + added function 'childObject2string()' to encode 'child'-references to option related string |
19 |
|
## + use new option at 'expand()' for replacing 'childObject2string' |
20 |
|
## |
21 |
## Revision 1.13 2003/02/21 01:48:50 joko |
## Revision 1.13 2003/02/21 01:48:50 joko |
22 |
## renamed core function |
## renamed core function |
23 |
## |
## |
65 |
## --------------------------------------------------------------------------- |
## --------------------------------------------------------------------------- |
66 |
|
|
67 |
|
|
68 |
package Data::Transform::Deep; |
package Data::Mungle::Transform::Deep; |
69 |
|
|
70 |
use strict; |
use strict; |
71 |
use warnings; |
use warnings; |
84 |
use Iterate; |
use Iterate; |
85 |
|
|
86 |
use Pitonyak::DeepCopy; |
use Pitonyak::DeepCopy; |
87 |
use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar ); |
use Data::Mungle::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar ); |
88 |
use Data::Code::Ref qw( ref_slot ); |
use Data::Mungle::Code::Ref qw( ref_slot ); |
89 |
|
|
90 |
sub numhash2list { |
sub numhash2list { |
91 |
my $vref = shift; |
my $vref = shift; |
171 |
my $item; |
my $item; |
172 |
# if current item is a reference ... |
# if current item is a reference ... |
173 |
if (ref $_[0]) { |
if (ref $_[0]) { |
174 |
# ... expand structure recursively |
$item = $_[0]; |
175 |
$item = expand($_[0], $options); |
# if $options->{childObj2string} is TRUE or STRING don't expand referenced object, |
176 |
|
# instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> ) |
177 |
|
if ($item && $options->{childObj2string}) { |
178 |
|
$item = childObj2string($item, $options->{childObj2string}); |
179 |
|
} else { |
180 |
|
# ... expand structure recursively |
181 |
|
$item = expand($_[0], $options); |
182 |
|
} |
183 |
# destroy item via seperate callback method (a POST) if requested |
# destroy item via seperate callback method (a POST) if requested |
184 |
#$options->{cb}->{destroy}->($_[0]) if $options->{destroy}; |
#$options->{cb}->{destroy}->($_[0]) if $options->{destroy}; |
185 |
|
|
208 |
|
|
209 |
# if current item is a reference ... |
# if current item is a reference ... |
210 |
if (ref $_[1]) { |
if (ref $_[1]) { |
211 |
# ... expand structure recursively |
$item = $_[1]; |
212 |
$item = expand($_[1], $options); |
# if $options->{childObj2string} is TRUE or STRING don't expand referenced object, |
213 |
|
# instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> ) |
214 |
|
if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) { |
215 |
|
$item = childObj2string($item, $options->{childObj2string}); |
216 |
|
} else { |
217 |
|
# ... expand structure recursively |
218 |
|
$item = expand($_[1], $options); |
219 |
|
} |
220 |
# destroy item via seperate callback method (a POST) if requested |
# destroy item via seperate callback method (a POST) if requested |
221 |
#$options->{cb}->{destroy}->($_[1]) if $options->{destroy}; |
#$options->{cb}->{destroy}->($_[1]) if $options->{destroy}; |
222 |
|
|
300 |
sub merge_to { |
sub merge_to { |
301 |
_hash2object(@_); |
_hash2object(@_); |
302 |
# TODO: |
# TODO: |
303 |
# re-implement using CPAN's "Iterate". |
# re-implement using CPAN's "Iterate" and/or a modified Hash::Merge. |
304 |
} |
} |
305 |
|
|
306 |
|
|
317 |
numhash2list($data) if ($options->{php}); |
numhash2list($data) if ($options->{php}); |
318 |
|
|
319 |
# utf8-conversion/-encoding (essential for I18N) |
# utf8-conversion/-encoding (essential for I18N) |
320 |
var_utf2iso($data) if ($options->{utf8}); |
utf8_to_latin($data) if ($options->{utf8}); |
321 |
|
|
322 |
# get fresh object from database |
# get fresh object from database |
323 |
# todo: |
# todo: |
488 |
} |
} |
489 |
|
|
490 |
|
|
491 |
|
sub childObj2string { |
492 |
|
my $obj = shift; |
493 |
|
my $option = shift; |
494 |
|
my $classname = ref $obj; |
495 |
|
|
496 |
|
if($option == 1) { |
497 |
|
my $string = "o_" . $obj->{guid} . "_" . $classname; |
498 |
|
} |
499 |
|
return $string; |
500 |
|
} |
501 |
|
|
502 |
|
|
503 |
1; |
1; |
504 |
__END__ |
__END__ |