/[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.14 by jonen, Sat Feb 22 17:13:55 2003 UTC revision 1.24 by joko, Mon Jun 7 16:44:54 2004 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.24  2004/06/07 16:44:54  joko
6    ##  sub expand: Now also converts hash-keys to/from utf-8
7    ##
8    ##  Revision 1.23  2003/05/13 07:39:22  joko
9    ##  new option 'define' for "sub expand": set value to empty string if desired
10    ##
11    ##  Revision 1.22  2003/05/10 17:09:18  jonen
12    ##  + added keep of empty arrays/hashes if 'expand' for php
13    ##
14    ##  Revision 1.21  2003/04/09 07:21:56  joko
15    ##  childObj2string now inside Encode.pm, renamed to 'twingle_reference'
16    ##
17    ##  Revision 1.20  2003/04/04 17:31:23  joko
18    ##  minor update to 'childObj2string'
19    ##
20    ##  Revision 1.19  2003/03/28 03:11:25  jonen
21    ##  + bugfix
22    ##
23    ##  Revision 1.18  2003/03/28 03:07:26  jonen
24    ##  + minor changes
25    ##
26    ##  Revision 1.17  2003/03/27 15:17:07  joko
27    ##  namespace fixes for Data::Mungle::*
28    ##
29    ##  Revision 1.16  2003/03/27 15:04:52  joko
30    ##  minor update: comment
31    ##
32    ##  Revision 1.15  2003/02/27 14:39:48  jonen
33    ##  + fixed bug at _hash2object()
34    ##
35  ##  Revision 1.14  2003/02/22 17:13:55  jonen  ##  Revision 1.14  2003/02/22 17:13:55  jonen
36  ##  + added function 'childObject2string()' to encode 'child'-references to option related string  ##  + added function 'childObject2string()' to encode 'child'-references to option related string
37  ##  + use new option at 'expand()' for replacing 'childObject2string'  ##  + use new option at 'expand()' for replacing 'childObject2string'
# Line 53  Line 83 
83  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
84    
85    
86  package Data::Transform::Deep;  package Data::Mungle::Transform::Deep;
87    
88  use strict;  use strict;
89  use warnings;  use warnings;
# Line 72  use Data::Dumper; Line 102  use Data::Dumper;
102  use Iterate;  use Iterate;
103    
104  use Pitonyak::DeepCopy;  use Pitonyak::DeepCopy;
105  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 );
106  use Data::Code::Ref qw( ref_slot );  use Data::Mungle::Code::Ref qw( ref_slot );
107    
108  sub numhash2list {  sub numhash2list {
109    my $vref = shift;    my $vref = shift;
# Line 145  sub _var_deref_test { Line 175  sub _var_deref_test {
175    
176  # 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
177  # but still using the known latin locale stuff  # but still using the known latin locale stuff
178    # TODO: Review: Could this be revamped using Clone.pm?
179  sub expand {  sub expand {
180    
181    my $obj = shift;    my $obj = shift;
# Line 154  sub expand { Line 185  sub expand {
185    #print "ref: ", ref $obj, "\n";    #print "ref: ", ref $obj, "\n";
186    
187    if (ref $obj eq 'ARRAY') {    if (ref $obj eq 'ARRAY') {
188      
189       # if we expand for php, keep empty ARRAY
190       if($#$obj == -1 && $options->{childObj2string}) {
191         $result = $obj;
192       } else {
193      IterArray @$obj, sub {      IterArray @$obj, sub {
194        my $item;        my $item;
195        # if current item is a reference ...        # if current item is a reference ...
# Line 163  sub expand { Line 198  sub expand {
198          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
199          # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )          # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
200          if ($item && $options->{childObj2string}) {          if ($item && $options->{childObj2string}) {
201            $item = childObj2string($item, $options->{childObj2string});            $item = twingle_reference($item);
202          } else {          } else {
203            # ... expand structure recursively            # ... expand structure recursively
204            $item = expand($_[0], $options);            $item = expand($_[0], $options);
# Line 179  sub expand { Line 214  sub expand {
214          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});
215          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});
216        }        }
217          
218          $item = '' if $options->{define} and not defined $item;
219        #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)
220        push(@{$result}, $item);                 # use item in any case        push(@{$result}, $item);                 # use item in any case
221    
222      }      }
223       }
224    
225    } elsif (ref $obj eq 'CODE') {    } elsif (ref $obj eq 'CODE') {
226      #print Dumper($obj);      #print Dumper($obj);
# Line 190  sub expand { Line 228  sub expand {
228    
229    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???
230    } elsif (ref $obj) {    } elsif (ref $obj) {
231      
232       # if we expand for php, keep empty HASH
233       my @tmp = keys %$obj;
234       if($#tmp == -1 && $options->{childObj2string}) {
235         $result = $obj;
236       } else {
237      IterHash %$obj, sub {      IterHash %$obj, sub {
238          my $key = $_[0];
239        my $item;        my $item;
240          
241          # conversions/encodings
242          $key = latin_to_utf8_scalar($key) if ($key && $options->{utf8});
243          $key = utf8_to_latin_scalar($key) if ($key && $options->{to_latin});
244    
245        # if current item is a reference ...        # if current item is a reference ...
246        if (ref $_[1]) {        if (ref $_[1]) {
247          $item = $_[1];          $item = $_[1];
248          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
249          # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )          # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
250          if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) {          if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH") && !(ref $_[1] eq "Set::Object")) {
251            $item = childObj2string($item, $options->{childObj2string});            $item = twingle_reference($item);
252          } else {          } else {
253            # ... expand structure recursively            # ... expand structure recursively
254            $item = expand($_[1], $options);            $item = expand($_[1], $options);
# Line 216  sub expand { Line 264  sub expand {
264          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});
265          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});
266        }        }
267          
268          $item = '' if $options->{define} and not defined $item;
269        #$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)
270        $result->{$_[0]} = $item;               # use item in any case        $result->{$key} = $item;               # use item in any case
271      }      }
272       }
273    
274    } else {    } else {
275      #die ("not a reference!");      #die ("not a reference!");
# Line 288  sub _var_traverse_mixin_update_old { Line 339  sub _var_traverse_mixin_update_old {
339  sub merge_to {  sub merge_to {
340    _hash2object(@_);    _hash2object(@_);
341    # TODO:    # TODO:
342    # re-implement using CPAN's "Iterate".    # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge.
343  }  }
344    
345    
# Line 305  sub _hash2object { Line 356  sub _hash2object {
356    numhash2list($data) if ($options->{php});    numhash2list($data) if ($options->{php});
357    
358    # utf8-conversion/-encoding (essential for I18N)    # utf8-conversion/-encoding (essential for I18N)
359    var_utf2iso($data) if ($options->{utf8});    utf8_to_latin($data) if ($options->{utf8});
360    
361    # get fresh object from database    # get fresh object from database
362    # todo:    # todo:
# Line 476  sub deep_copy { Line 527  sub deep_copy {
527  }  }
528    
529    
 sub childObj2string {  
   my $obj = shift;  
   my $option = shift;  
   my $classname = ref $obj;  
     
   if($option == 1) {  
     my $string = "o_" . $classname . "_" .$obj->{guid};  
     return $string;  
   }    
 }  
   
   
530  1;  1;
531  __END__  __END__
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.24
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed