/[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.10 by joko, Thu Feb 20 20:48:00 2003 UTC revision 1.19 by jonen, Fri Mar 28 03:11:25 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.19  2003/03/28 03:11:25  jonen
6    ##  + bugfix
7    ##
8    ##  Revision 1.18  2003/03/28 03:07:26  jonen
9    ##  + minor changes
10    ##
11    ##  Revision 1.17  2003/03/27 15:17:07  joko
12    ##  namespace fixes for Data::Mungle::*
13    ##
14    ##  Revision 1.16  2003/03/27 15:04:52  joko
15    ##  minor update: comment
16    ##
17    ##  Revision 1.15  2003/02/27 14:39:48  jonen
18    ##  + fixed bug at _hash2object()
19    ##
20    ##  Revision 1.14  2003/02/22 17:13:55  jonen
21    ##  + added function 'childObject2string()' to encode 'child'-references to option related string
22    ##  + use new option at 'expand()' for replacing 'childObject2string'
23    ##
24    ##  Revision 1.13  2003/02/21 01:48:50  joko
25    ##  renamed core function
26    ##
27    ##  Revision 1.12  2003/02/20 22:45:19  joko
28    ##  fix regarding new deep_copy
29    ##
30    ##  Revision 1.11  2003/02/20 21:13:54  joko
31    ##  - removed implementation of deep_copy2 - get this from the Pitonyak namespace (now cloned to repository)
32    ##
33  ##  Revision 1.10  2003/02/20 20:48:00  joko  ##  Revision 1.10  2003/02/20 20:48:00  joko
34  ##  - refactored lots of code to Data::Code::Ref  ##  - refactored lots of code to Data::Code::Ref
35  ##  + alternative 'deep_copy' implementation  ##  + alternative 'deep_copy' implementation
# Line 40  Line 68 
68  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
69    
70    
71  package Data::Transform::Deep;  package Data::Mungle::Transform::Deep;
72    
73  use strict;  use strict;
74  use warnings;  use warnings;
# Line 58  use attributes; Line 86  use attributes;
86  use Data::Dumper;  use Data::Dumper;
87  use Iterate;  use Iterate;
88    
89  use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar );  use Pitonyak::DeepCopy;
90  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 );
91    use Data::Mungle::Code::Ref qw( ref_slot );
92    
93  sub numhash2list {  sub numhash2list {
94    my $vref = shift;    my $vref = shift;
# Line 129  sub _var_deref_test { Line 158  sub _var_deref_test {
158  }  }
159    
160    
161    # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML
162    # but still using the known latin locale stuff
163  sub expand {  sub expand {
164    
165    my $obj = shift;    my $obj = shift;
# Line 143  sub expand { Line 174  sub expand {
174        my $item;        my $item;
175        # if current item is a reference ...        # if current item is a reference ...
176        if (ref $_[0]) {        if (ref $_[0]) {
177          # ... expand structure recursively          $item = $_[0];
178          $item = expand($_[0], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
179            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
180            if ($item && $options->{childObj2string}) {
181              $item = childObj2string($item, $options->{childObj2string});
182            } else {
183              # ... expand structure recursively
184              $item = expand($_[0], $options);
185            }
186          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
187          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};
188    
# Line 173  sub expand { Line 211  sub expand {
211                
212        # if current item is a reference ...        # if current item is a reference ...
213        if (ref $_[1]) {        if (ref $_[1]) {
214          # ... expand structure recursively          $item = $_[1];
215          $item = expand($_[1], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
216            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
217            if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) {
218              $item = childObj2string($item, $options->{childObj2string});
219            } else {
220              # ... expand structure recursively
221              $item = expand($_[1], $options);
222            }
223          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
224          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};
225                
# Line 198  sub expand { Line 243  sub expand {
243    
244    # convert all values to utf8 (inside complex struct)    # convert all values to utf8 (inside complex struct)
245      # 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
246      # var2utf8($result) if ($options->{utf8});      # latin_to_utf8($result) if ($options->{utf8});
247    
248    # 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
249    #undef $obj if $options->{destroy};    #undef $obj if $options->{destroy};
# Line 258  sub _var_traverse_mixin_update_old { Line 303  sub _var_traverse_mixin_update_old {
303  sub merge_to {  sub merge_to {
304    _hash2object(@_);    _hash2object(@_);
305    # TODO:    # TODO:
306    # re-implement using CPAN's "Iterate".    # re-implement using CPAN's "Iterate" and/or a modified Hash::Merge.
307  }  }
308    
309    
# Line 275  sub _hash2object { Line 320  sub _hash2object {
320    numhash2list($data) if ($options->{php});    numhash2list($data) if ($options->{php});
321    
322    # utf8-conversion/-encoding (essential for I18N)    # utf8-conversion/-encoding (essential for I18N)
323    var_utf2iso($data) if ($options->{utf8});    utf8_to_latin($data) if ($options->{utf8});
324    
325    # get fresh object from database    # get fresh object from database
326    # todo:    # todo:
# Line 441  sub deep_copy1 { Line 486  sub deep_copy1 {
486  # ACK's go to Andrew Pitonyak  # ACK's go to Andrew Pitonyak
487  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)
488  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html
489  sub deep_copy2 {  sub deep_copy {
490      Pitonyak::DeepCopy::deep_copy(@_);
491      # if not defined then return it  }
     return undef if $#_ < 0 || !defined( $_[0] );  
   
     # if not a reference then return the parameter  
     return $_[0] if !ref( $_[0] );  
     my $obj = shift;  
     if ( UNIVERSAL::isa( $obj, 'SCALAR' ) ) {  
         my $temp = deep_copy2($$obj);  
         return \$temp;  
     }  
     elsif ( UNIVERSAL::isa( $obj, 'HASH' ) ) {  
         my $temp_hash = {};  
         foreach my $key ( keys %$obj ) {  
             if ( !defined( $obj->{$key} ) || !ref( $obj->{$key} ) ) {  
                 $temp_hash->{$key} = $obj->{$key};  
             }  
             else {  
                 $temp_hash->{$key} = deep_copy2( $obj->{$key} );  
             }  
         }  
         return $temp_hash;  
     }  
     elsif ( UNIVERSAL::isa( $obj, 'ARRAY' ) ) {  
         my $temp_array = [];  
         foreach my $array_val (@$obj) {  
             if ( !defined($array_val) || !ref($array_val) ) {  
                 push ( @$temp_array, $array_val );  
             }  
             else {  
                 push ( @$temp_array, deep_copy2($array_val) );  
             }  
         }  
         return $temp_array;  
     }  
492    
     # ?? I am uncertain about this one  
     elsif ( UNIVERSAL::isa( $obj, 'REF' ) ) {  
         my $temp = deep_copy2($$obj);  
         return \$temp;  
     }  
493    
494      # I guess that it is either CODE, GLOB or LVALUE  sub childObj2string {
495      else {    my $obj = shift;
496          return $obj;    my $option = shift;
497      }    my $classname = ref $obj;
498      my $string;
499      
500      if($option == 1) {
501        $string = "o_" . $obj->{guid} . "_" . $classname;
502      }  
503      return $string;
504  }  }
505    
 sub deep_copy {  
   deep_copy2(@_);  
 }  
506    
507  1;  1;
508  __END__  __END__
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.19
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed