/[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.20 by joko, Fri Apr 4 17:31:23 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  ##  Revision 1.20  2003/04/04 17:31:23  joko
12  ##  minor update to 'childObj2string'  ##  minor update to 'childObj2string'
13  ##  ##
# Line 90  use Data::Dumper; Line 96  use Data::Dumper;
96  use Iterate;  use Iterate;
97    
98  use Pitonyak::DeepCopy;  use Pitonyak::DeepCopy;
99  use Data::Mungle::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 twingle_reference );
100  use Data::Mungle::Code::Ref qw( ref_slot );  use Data::Mungle::Code::Ref qw( ref_slot );
101    
102  sub numhash2list {  sub numhash2list {
# Line 172  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 ...
# Line 181  sub expand { Line 191  sub expand {
191          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,          # 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> )          # instead replace it by per option choosed string (default: o_<classname>_<ref type>_<guid> )
193          if ($item && $options->{childObj2string}) {          if ($item && $options->{childObj2string}) {
194            $item = childObj2string($item, $options->{childObj2string});            $item = twingle_reference($item);
195          } else {          } else {
196            # ... expand structure recursively            # ... expand structure recursively
197            $item = expand($_[0], $options);            $item = expand($_[0], $options);
# Line 201  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 208  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                
# Line 217  sub expand { Line 233  sub expand {
233          $item = $_[1];          $item = $_[1];
234          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,          # 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> )          # 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")) {          if ($item && $options->{childObj2string} && !(ref $_[1] eq "ARRAY") && !(ref $_[1] eq "HASH") && !(ref $_[1] eq "Set::Object")) {
237            $item = childObj2string($item, $options->{childObj2string});            $item = twingle_reference($item);
238          } else {          } else {
239            # ... expand structure recursively            # ... expand structure recursively
240            $item = expand($_[1], $options);            $item = expand($_[1], $options);
# Line 237  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 494  sub deep_copy { Line 511  sub deep_copy {
511  }  }
512    
513    
 # encodes object-references to serialized string representations  
 # made up of:  
 #   - 'o_<classname>_<ref type>_<guid>'???  
 #   - 'o_{guid}_{classname}'!!!  
 sub childObj2string {  
   my $obj = shift;  
   my $option = shift;  
   my $string = 'n/a';  
     
   if ($option == 1) {  
     if ((my $classname = ref $obj) && (my $guid = $obj->{guid})) {  
       $string = join('_', 'o', $guid, $classname);  
     }    
   }  
     
   return $string;  
 }  
   
   
514  1;  1;
515  __END__  __END__
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.22
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed