/[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.17 by joko, Thu Mar 27 15:17:07 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.17  2003/03/27 15:17:07  joko
6    ##  namespace fixes for Data::Mungle::*
7    ##
8    ##  Revision 1.16  2003/03/27 15:04:52  joko
9    ##  minor update: comment
10    ##
11    ##  Revision 1.15  2003/02/27 14:39:48  jonen
12    ##  + fixed bug at _hash2object()
13    ##
14    ##  Revision 1.14  2003/02/22 17:13:55  jonen
15    ##  + added function 'childObject2string()' to encode 'child'-references to option related string
16    ##  + use new option at 'expand()' for replacing 'childObject2string'
17    ##
18    ##  Revision 1.13  2003/02/21 01:48:50  joko
19    ##  renamed core function
20    ##
21    ##  Revision 1.12  2003/02/20 22:45:19  joko
22    ##  fix regarding new deep_copy
23    ##
24  ##  Revision 1.11  2003/02/20 21:13:54  joko  ##  Revision 1.11  2003/02/20 21:13:54  joko
25  ##  - 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)
26  ##  ##
# Line 43  Line 62 
62  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
63    
64    
65  package Data::Transform::Deep;  package Data::Mungle::Transform::Deep;
66    
67  use strict;  use strict;
68  use warnings;  use warnings;
# Line 61  use attributes; Line 80  use attributes;
80  use Data::Dumper;  use Data::Dumper;
81  use Iterate;  use Iterate;
82    
83  use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar );  use Pitonyak::DeepCopy;
84  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 );
85    use Data::Mungle::Code::Ref qw( ref_slot );
86    
87  sub numhash2list {  sub numhash2list {
88    my $vref = shift;    my $vref = shift;
# Line 132  sub _var_deref_test { Line 152  sub _var_deref_test {
152  }  }
153    
154    
155    # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML
156    # but still using the known latin locale stuff
157  sub expand {  sub expand {
158    
159    my $obj = shift;    my $obj = shift;
# Line 146  sub expand { Line 168  sub expand {
168        my $item;        my $item;
169        # if current item is a reference ...        # if current item is a reference ...
170        if (ref $_[0]) {        if (ref $_[0]) {
171          # ... expand structure recursively          $item = $_[0];
172          $item = expand($_[0], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
173            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
174            if ($item && $options->{childObj2string}) {
175              $item = childObj2string($item, $options->{childObj2string});
176            } else {
177              # ... expand structure recursively
178              $item = expand($_[0], $options);
179            }
180          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
181          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};
182    
# Line 176  sub expand { Line 205  sub expand {
205                
206        # if current item is a reference ...        # if current item is a reference ...
207        if (ref $_[1]) {        if (ref $_[1]) {
208          # ... expand structure recursively          $item = $_[1];
209          $item = expand($_[1], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
210            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
211            if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) {
212              $item = childObj2string($item, $options->{childObj2string});
213            } else {
214              # ... expand structure recursively
215              $item = expand($_[1], $options);
216            }
217          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
218          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};
219                
# Line 201  sub expand { Line 237  sub expand {
237    
238    # convert all values to utf8 (inside complex struct)    # convert all values to utf8 (inside complex struct)
239      # 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
240      # var2utf8($result) if ($options->{utf8});      # latin_to_utf8($result) if ($options->{utf8});
241    
242    # 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
243    #undef $obj if $options->{destroy};    #undef $obj if $options->{destroy};
# Line 261  sub _var_traverse_mixin_update_old { Line 297  sub _var_traverse_mixin_update_old {
297  sub merge_to {  sub merge_to {
298    _hash2object(@_);    _hash2object(@_);
299    # TODO:    # TODO:
300    # re-implement using CPAN's "Iterate".    # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge.
301  }  }
302    
303    
# Line 278  sub _hash2object { Line 314  sub _hash2object {
314    numhash2list($data) if ($options->{php});    numhash2list($data) if ($options->{php});
315    
316    # utf8-conversion/-encoding (essential for I18N)    # utf8-conversion/-encoding (essential for I18N)
317    var_utf2iso($data) if ($options->{utf8});    utf8_to_latin($data) if ($options->{utf8});
318    
319    # get fresh object from database    # get fresh object from database
320    # todo:    # todo:
# Line 445  sub deep_copy1 { Line 481  sub deep_copy1 {
481  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)
482  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html
483  sub deep_copy {  sub deep_copy {
484    Pitonyak::deep_copy(@_);    Pitonyak::DeepCopy::deep_copy(@_);
485    }
486    
487    
488    sub childObj2string {
489      my $obj = shift;
490      my $option = shift;
491      my $classname = ref $obj;
492      
493      if($option == 1) {
494        my $string = "o_" . $classname . "_" .$obj->{guid};
495        return $string;
496      }  
497  }  }
498    
499    
500  1;  1;
501  __END__  __END__
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.17
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed