/[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.12 by joko, Thu Feb 20 22:45:19 2003 UTC revision 1.20 by joko, Fri Apr 4 17:31:23 2003 UTC
# Line 2  Line 2 
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  ##  Revision 1.12  2003/02/20 22:45:19  joko
31  ##  fix regarding new deep_copy  ##  fix regarding new deep_copy
32  ##  ##
# Line 46  Line 71 
71  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
72    
73    
74  package Data::Transform::Deep;  package Data::Mungle::Transform::Deep;
75    
76  use strict;  use strict;
77  use warnings;  use warnings;
# Line 65  use Data::Dumper; Line 90  use Data::Dumper;
90  use Iterate;  use Iterate;
91    
92  use Pitonyak::DeepCopy;  use Pitonyak::DeepCopy;
93  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 );
94  use Data::Code::Ref qw( ref_slot );  use Data::Mungle::Code::Ref qw( ref_slot );
95    
96  sub numhash2list {  sub numhash2list {
97    my $vref = shift;    my $vref = shift;
# Line 136  sub _var_deref_test { Line 161  sub _var_deref_test {
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;
# Line 150  sub expand { Line 177  sub expand {
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    
# Line 180  sub expand { Line 214  sub expand {
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                
# Line 205  sub expand { Line 246  sub expand {
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};
# Line 265  sub _var_traverse_mixin_update_old { Line 306  sub _var_traverse_mixin_update_old {
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    
# Line 282  sub _hash2object { Line 323  sub _hash2object {
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:
# Line 453  sub deep_copy { Line 494  sub 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__

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.20

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed