/[cvs]/nfo/perl/libs/Data/Mungle/Transform/Deep.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Mungle/Transform/Deep.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by joko, Fri Feb 21 01:48:50 2003 UTC revision 1.23 by joko, Tue May 13 07:39:22 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.23  2003/05/13 07:39:22  joko
6    ##  new option 'define' for "sub expand": set value to empty string if desired
7    ##
8    ##  Revision 1.22  2003/05/10 17:09:18  jonen
9    ##  + added keep of empty arrays/hashes if 'expand' for php
10    ##
11    ##  Revision 1.21  2003/04/09 07:21:56  joko
12    ##  childObj2string now inside Encode.pm, renamed to 'twingle_reference'
13    ##
14    ##  Revision 1.20  2003/04/04 17:31:23  joko
15    ##  minor update to 'childObj2string'
16    ##
17    ##  Revision 1.19  2003/03/28 03:11:25  jonen
18    ##  + bugfix
19    ##
20    ##  Revision 1.18  2003/03/28 03:07:26  jonen
21    ##  + minor changes
22    ##
23    ##  Revision 1.17  2003/03/27 15:17:07  joko
24    ##  namespace fixes for Data::Mungle::*
25    ##
26    ##  Revision 1.16  2003/03/27 15:04:52  joko
27    ##  minor update: comment
28    ##
29    ##  Revision 1.15  2003/02/27 14:39:48  jonen
30    ##  + fixed bug at _hash2object()
31    ##
32    ##  Revision 1.14  2003/02/22 17:13:55  jonen
33    ##  + added function 'childObject2string()' to encode 'child'-references to option related string
34    ##  + use new option at 'expand()' for replacing 'childObject2string'
35    ##
36  ##  Revision 1.13  2003/02/21 01:48:50  joko  ##  Revision 1.13  2003/02/21 01:48:50  joko
37  ##  renamed core function  ##  renamed core function
38  ##  ##
# Line 49  Line 80 
80  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
81    
82    
83  package Data::Transform::Deep;  package Data::Mungle::Transform::Deep;
84    
85  use strict;  use strict;
86  use warnings;  use warnings;
# Line 68  use Data::Dumper; Line 99  use Data::Dumper;
99  use Iterate;  use Iterate;
100    
101  use Pitonyak::DeepCopy;  use Pitonyak::DeepCopy;
102  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 twingle_reference );
103  use Data::Code::Ref qw( ref_slot );  use Data::Mungle::Code::Ref qw( ref_slot );
104    
105  sub numhash2list {  sub numhash2list {
106    my $vref = shift;    my $vref = shift;
# Line 141  sub _var_deref_test { Line 172  sub _var_deref_test {
172    
173  # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML  # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML
174  # but still using the known latin locale stuff  # but still using the known latin locale stuff
175    # TODO: Review: Could this be revamped using Clone.pm?
176  sub expand {  sub expand {
177    
178    my $obj = shift;    my $obj = shift;
# Line 150  sub expand { Line 182  sub expand {
182    #print "ref: ", ref $obj, "\n";    #print "ref: ", ref $obj, "\n";
183    
184    if (ref $obj eq 'ARRAY') {    if (ref $obj eq 'ARRAY') {
185      
186       # if we expand for php, keep empty ARRAY
187       if($#$obj == -1 && $options->{childObj2string}) {
188         $result = $obj;
189       } else {
190      IterArray @$obj, sub {      IterArray @$obj, sub {
191        my $item;        my $item;
192        # if current item is a reference ...        # if current item is a reference ...
193        if (ref $_[0]) {        if (ref $_[0]) {
194          # ... expand structure recursively          $item = $_[0];
195          $item = expand($_[0], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
196            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
197            if ($item && $options->{childObj2string}) {
198              $item = twingle_reference($item);
199            } else {
200              # ... expand structure recursively
201              $item = expand($_[0], $options);
202            }
203          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
204          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};
205    
# Line 168  sub expand { Line 211  sub expand {
211          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});
212          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});
213        }        }
214          
215          $item = '' if $options->{define} and not defined $item;
216        #push(@{$result}, $item) if $item;   # use item only if not undef  (TODO: make configurable via $options)        #push(@{$result}, $item) if $item;   # use item only if not undef  (TODO: make configurable via $options)
217        push(@{$result}, $item);                 # use item in any case        push(@{$result}, $item);                 # use item in any case
218    
219      }      }
220       }
221    
222    } elsif (ref $obj eq 'CODE') {    } elsif (ref $obj eq 'CODE') {
223      #print Dumper($obj);      #print Dumper($obj);
# Line 179  sub expand { Line 225  sub expand {
225    
226    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???
227    } elsif (ref $obj) {    } elsif (ref $obj) {
228      
229       # if we expand for php, keep empty HASH
230       my @tmp = keys %$obj;
231       if($#tmp == -1 && $options->{childObj2string}) {
232         $result = $obj;
233       } else {
234      IterHash %$obj, sub {      IterHash %$obj, sub {
235        my $item;        my $item;
236                
237        # if current item is a reference ...        # if current item is a reference ...
238        if (ref $_[1]) {        if (ref $_[1]) {
239          # ... expand structure recursively          $item = $_[1];
240          $item = expand($_[1], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
241            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
242            if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH") && !(ref $_[1] eq "Set::Object")) {
243              $item = twingle_reference($item);
244            } else {
245              # ... expand structure recursively
246              $item = expand($_[1], $options);
247            }
248          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
249          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};
250                
# Line 198  sub expand { Line 256  sub expand {
256          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});
257          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});
258        }        }
259          
260          $item = '' if $options->{define} and not defined $item;
261        #$result->{$_[0]} = $item if $item;   # use item only if not undef  (TODO: make configurable via $options)        #$result->{$_[0]} = $item if $item;   # use item only if not undef  (TODO: make configurable via $options)
262        $result->{$_[0]} = $item;               # use item in any case        $result->{$_[0]} = $item;               # use item in any case
263      }      }
264       }
265    
266    } else {    } else {
267      #die ("not a reference!");      #die ("not a reference!");
# Line 270  sub _var_traverse_mixin_update_old { Line 331  sub _var_traverse_mixin_update_old {
331  sub merge_to {  sub merge_to {
332    _hash2object(@_);    _hash2object(@_);
333    # TODO:    # TODO:
334    # re-implement using CPAN's "Iterate".    # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge.
335  }  }
336    
337    
# Line 287  sub _hash2object { Line 348  sub _hash2object {
348    numhash2list($data) if ($options->{php});    numhash2list($data) if ($options->{php});
349    
350    # utf8-conversion/-encoding (essential for I18N)    # utf8-conversion/-encoding (essential for I18N)
351    var_utf2iso($data) if ($options->{utf8});    utf8_to_latin($data) if ($options->{utf8});
352    
353    # get fresh object from database    # get fresh object from database
354    # todo:    # todo:
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.23
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed