/[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.11 by joko, Thu Feb 20 21:13:54 2003 UTC revision 1.22 by jonen, Sat May 10 17:09:18 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.22  2003/05/10 17:09:18  jonen
6    ##  + added keep of empty arrays/hashes if 'expand' for php
7    ##
8    ##  Revision 1.21  2003/04/09 07:21:56  joko
9    ##  childObj2string now inside Encode.pm, renamed to 'twingle_reference'
10    ##
11    ##  Revision 1.20  2003/04/04 17:31:23  joko
12    ##  minor update to 'childObj2string'
13    ##
14    ##  Revision 1.19  2003/03/28 03:11:25  jonen
15    ##  + bugfix
16    ##
17    ##  Revision 1.18  2003/03/28 03:07:26  jonen
18    ##  + minor changes
19    ##
20    ##  Revision 1.17  2003/03/27 15:17:07  joko
21    ##  namespace fixes for Data::Mungle::*
22    ##
23    ##  Revision 1.16  2003/03/27 15:04:52  joko
24    ##  minor update: comment
25    ##
26    ##  Revision 1.15  2003/02/27 14:39:48  jonen
27    ##  + fixed bug at _hash2object()
28    ##
29    ##  Revision 1.14  2003/02/22 17:13:55  jonen
30    ##  + added function 'childObject2string()' to encode 'child'-references to option related string
31    ##  + use new option at 'expand()' for replacing 'childObject2string'
32    ##
33    ##  Revision 1.13  2003/02/21 01:48:50  joko
34    ##  renamed core function
35    ##
36    ##  Revision 1.12  2003/02/20 22:45:19  joko
37    ##  fix regarding new deep_copy
38    ##
39  ##  Revision 1.11  2003/02/20 21:13:54  joko  ##  Revision 1.11  2003/02/20 21:13:54  joko
40  ##  - 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)
41  ##  ##
# Line 43  Line 77 
77  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
78    
79    
80  package Data::Transform::Deep;  package Data::Mungle::Transform::Deep;
81    
82  use strict;  use strict;
83  use warnings;  use warnings;
# Line 61  use attributes; Line 95  use attributes;
95  use Data::Dumper;  use Data::Dumper;
96  use Iterate;  use Iterate;
97    
98  use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar );  use Pitonyak::DeepCopy;
99  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 );
100    use Data::Mungle::Code::Ref qw( ref_slot );
101    
102  sub numhash2list {  sub numhash2list {
103    my $vref = shift;    my $vref = shift;
# Line 132  sub _var_deref_test { Line 167  sub _var_deref_test {
167  }  }
168    
169    
170    # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML
171    # but still using the known latin locale stuff
172  sub expand {  sub expand {
173    
174    my $obj = shift;    my $obj = shift;
# Line 141  sub expand { Line 178  sub expand {
178    #print "ref: ", ref $obj, "\n";    #print "ref: ", ref $obj, "\n";
179    
180    if (ref $obj eq 'ARRAY') {    if (ref $obj eq 'ARRAY') {
181      
182       # if we expand for php, keep empty ARRAY
183       if($#$obj == -1 && $options->{childObj2string}) {
184         $result = $obj;
185       } else {
186      IterArray @$obj, sub {      IterArray @$obj, sub {
187        my $item;        my $item;
188        # if current item is a reference ...        # if current item is a reference ...
189        if (ref $_[0]) {        if (ref $_[0]) {
190          # ... expand structure recursively          $item = $_[0];
191          $item = expand($_[0], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
192            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
193            if ($item && $options->{childObj2string}) {
194              $item = twingle_reference($item);
195            } else {
196              # ... expand structure recursively
197              $item = expand($_[0], $options);
198            }
199          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
200          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};
201    
# Line 163  sub expand { Line 211  sub expand {
211        push(@{$result}, $item);                 # use item in any case        push(@{$result}, $item);                 # use item in any case
212    
213      }      }
214       }
215    
216    } elsif (ref $obj eq 'CODE') {    } elsif (ref $obj eq 'CODE') {
217      #print Dumper($obj);      #print Dumper($obj);
# Line 170  sub expand { Line 219  sub expand {
219    
220    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???
221    } elsif (ref $obj) {    } elsif (ref $obj) {
222      
223       # if we expand for php, keep empty HASH
224       my @tmp = keys %$obj;
225       if($#tmp == -1 && $options->{childObj2string}) {
226         $result = $obj;
227       } else {
228      IterHash %$obj, sub {      IterHash %$obj, sub {
229        my $item;        my $item;
230                
231        # if current item is a reference ...        # if current item is a reference ...
232        if (ref $_[1]) {        if (ref $_[1]) {
233          # ... expand structure recursively          $item = $_[1];
234          $item = expand($_[1], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
235            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
236            if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH") && !(ref $_[1] eq "Set::Object")) {
237              $item = twingle_reference($item);
238            } else {
239              # ... expand structure recursively
240              $item = expand($_[1], $options);
241            }
242          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
243          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};
244                
# Line 192  sub expand { Line 253  sub expand {
253        #$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)
254        $result->{$_[0]} = $item;               # use item in any case        $result->{$_[0]} = $item;               # use item in any case
255      }      }
256       }
257    
258    } else {    } else {
259      #die ("not a reference!");      #die ("not a reference!");
# Line 201  sub expand { Line 263  sub expand {
263    
264    # convert all values to utf8 (inside complex struct)    # convert all values to utf8 (inside complex struct)
265      # 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
266      # var2utf8($result) if ($options->{utf8});      # latin_to_utf8($result) if ($options->{utf8});
267    
268    # 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
269    #undef $obj if $options->{destroy};    #undef $obj if $options->{destroy};
# Line 261  sub _var_traverse_mixin_update_old { Line 323  sub _var_traverse_mixin_update_old {
323  sub merge_to {  sub merge_to {
324    _hash2object(@_);    _hash2object(@_);
325    # TODO:    # TODO:
326    # re-implement using CPAN's "Iterate".    # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge.
327  }  }
328    
329    
# Line 278  sub _hash2object { Line 340  sub _hash2object {
340    numhash2list($data) if ($options->{php});    numhash2list($data) if ($options->{php});
341    
342    # utf8-conversion/-encoding (essential for I18N)    # utf8-conversion/-encoding (essential for I18N)
343    var_utf2iso($data) if ($options->{utf8});    utf8_to_latin($data) if ($options->{utf8});
344    
345    # get fresh object from database    # get fresh object from database
346    # todo:    # todo:
# Line 445  sub deep_copy1 { Line 507  sub deep_copy1 {
507  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)
508  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html
509  sub deep_copy {  sub deep_copy {
510    Pitonyak::deep_copy(@_);    Pitonyak::DeepCopy::deep_copy(@_);
511  }  }
512    
513    
514  1;  1;
515  __END__  __END__
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.22
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed