/[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.14 by jonen, Sat Feb 22 17:13:55 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.14  2003/02/22 17:13:55  jonen
6    ##  + added function 'childObject2string()' to encode 'child'-references to option related string
7    ##  + use new option at 'expand()' for replacing 'childObject2string'
8    ##
9    ##  Revision 1.13  2003/02/21 01:48:50  joko
10    ##  renamed core function
11    ##
12    ##  Revision 1.12  2003/02/20 22:45:19  joko
13    ##  fix regarding new deep_copy
14    ##
15  ##  Revision 1.11  2003/02/20 21:13:54  joko  ##  Revision 1.11  2003/02/20 21:13:54  joko
16  ##  - 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)
17  ##  ##
# Line 61  use attributes; Line 71  use attributes;
71  use Data::Dumper;  use Data::Dumper;
72  use Iterate;  use Iterate;
73    
74    use Pitonyak::DeepCopy;
75  use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar );  use Data::Transform::Encode qw( latin_to_utf8 latin_to_utf8_scalar utf8_to_latin utf8_to_latin_scalar );
76  use Data::Code::Ref qw( ref_slot );  use Data::Code::Ref qw( ref_slot );
77    
# Line 132  sub _var_deref_test { Line 143  sub _var_deref_test {
143  }  }
144    
145    
146    # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML
147    # but still using the known latin locale stuff
148  sub expand {  sub expand {
149    
150    my $obj = shift;    my $obj = shift;
# Line 146  sub expand { Line 159  sub expand {
159        my $item;        my $item;
160        # if current item is a reference ...        # if current item is a reference ...
161        if (ref $_[0]) {        if (ref $_[0]) {
162          # ... expand structure recursively          $item = $_[0];
163          $item = expand($_[0], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
164            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
165            if ($item && $options->{childObj2string}) {
166              $item = childObj2string($item, $options->{childObj2string});
167            } else {
168              # ... expand structure recursively
169              $item = expand($_[0], $options);
170            }
171          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
172          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};
173    
# Line 176  sub expand { Line 196  sub expand {
196                
197        # if current item is a reference ...        # if current item is a reference ...
198        if (ref $_[1]) {        if (ref $_[1]) {
199          # ... expand structure recursively          $item = $_[1];
200          $item = expand($_[1], $options);          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
201            # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
202            if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH")) {
203              $item = childObj2string($item, $options->{childObj2string});
204            } else {
205              # ... expand structure recursively
206              $item = expand($_[1], $options);
207            }
208          # destroy item via seperate callback method (a POST) if requested          # destroy item via seperate callback method (a POST) if requested
209          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};          #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};
210                
# Line 201  sub expand { Line 228  sub expand {
228    
229    # convert all values to utf8 (inside complex struct)    # convert all values to utf8 (inside complex struct)
230      # 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
231      # var2utf8($result) if ($options->{utf8});      # latin_to_utf8($result) if ($options->{utf8});
232    
233    # 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
234    #undef $obj if $options->{destroy};    #undef $obj if $options->{destroy};
# Line 445  sub deep_copy1 { Line 472  sub deep_copy1 {
472  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)  # Copyright 2002, Andrew Pitonyak (perlboy@pitonyak.org)
473  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html  # please visit: http://www.pitonyak.org/code/perl/Pitonyak/DeepCopy.pm.html
474  sub deep_copy {  sub deep_copy {
475    Pitonyak::deep_copy(@_);    Pitonyak::DeepCopy::deep_copy(@_);
476  }  }
477    
478    
479    sub childObj2string {
480      my $obj = shift;
481      my $option = shift;
482      my $classname = ref $obj;
483      
484      if($option == 1) {
485        my $string = "o_" . $classname . "_" .$obj->{guid};
486        return $string;
487      }  
488    }
489    
490    
491  1;  1;
492  __END__  __END__
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.14
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed