/[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.21 by joko, Wed Apr 9 07:21:56 2003 UTC revision 1.23 by joko, Tue May 13 07:39:22 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.23  2003/05/13 07:39:22  joko
6    ##  new option 'define' for "sub expand": set value to empty string if desired
7    ##
8    ##  Revision 1.22  2003/05/10 17:09:18  jonen
9    ##  + added keep of empty arrays/hashes if 'expand' for php
10    ##
11  ##  Revision 1.21  2003/04/09 07:21:56  joko  ##  Revision 1.21  2003/04/09 07:21:56  joko
12  ##  childObj2string now inside Encode.pm, renamed to 'twingle_reference'  ##  childObj2string now inside Encode.pm, renamed to 'twingle_reference'
13  ##  ##
# Line 166  sub _var_deref_test { Line 172  sub _var_deref_test {
172    
173  # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML  # convert values in hash to utf8 (and back) to be ready for (e.g.) encapsulation in XML
174  # but still using the known latin locale stuff  # but still using the known latin locale stuff
175    # TODO: Review: Could this be revamped using Clone.pm?
176  sub expand {  sub expand {
177    
178    my $obj = shift;    my $obj = shift;
# Line 175  sub expand { Line 182  sub expand {
182    #print "ref: ", ref $obj, "\n";    #print "ref: ", ref $obj, "\n";
183    
184    if (ref $obj eq 'ARRAY') {    if (ref $obj eq 'ARRAY') {
185      
186       # if we expand for php, keep empty ARRAY
187       if($#$obj == -1 && $options->{childObj2string}) {
188         $result = $obj;
189       } else {
190      IterArray @$obj, sub {      IterArray @$obj, sub {
191        my $item;        my $item;
192        # if current item is a reference ...        # if current item is a reference ...
# Line 200  sub expand { Line 211  sub expand {
211          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});
212          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});
213        }        }
214          
215          $item = '' if $options->{define} and not defined $item;
216        #push(@{$result}, $item) if $item;   # use item only if not undef  (TODO: make configurable via $options)        #push(@{$result}, $item) if $item;   # use item only if not undef  (TODO: make configurable via $options)
217        push(@{$result}, $item);                 # use item in any case        push(@{$result}, $item);                 # use item in any case
218    
219      }      }
220       }
221    
222    } elsif (ref $obj eq 'CODE') {    } elsif (ref $obj eq 'CODE') {
223      #print Dumper($obj);      #print Dumper($obj);
# Line 211  sub expand { Line 225  sub expand {
225    
226    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???    # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???
227    } elsif (ref $obj) {    } elsif (ref $obj) {
228      
229       # if we expand for php, keep empty HASH
230       my @tmp = keys %$obj;
231       if($#tmp == -1 && $options->{childObj2string}) {
232         $result = $obj;
233       } else {
234      IterHash %$obj, sub {      IterHash %$obj, sub {
235        my $item;        my $item;
236                
# Line 220  sub expand { Line 239  sub expand {
239          $item = $_[1];          $item = $_[1];
240          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,          # if $options->{childObj2string} is TRUE or STRING don't expand referenced object,
241          # 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> )
242          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")) {
243            $item = twingle_reference($item);            $item = twingle_reference($item);
244          } else {          } else {
245            # ... expand structure recursively            # ... expand structure recursively
# Line 237  sub expand { Line 256  sub expand {
256          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});          $item = latin_to_utf8_scalar($item) if ($item && $options->{utf8});
257          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});          $item = utf8_to_latin_scalar($item) if ($item && $options->{to_latin});
258        }        }
259          
260          $item = '' if $options->{define} and not defined $item;
261        #$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)
262        $result->{$_[0]} = $item;               # use item in any case        $result->{$_[0]} = $item;               # use item in any case
263      }      }
264       }
265    
266    } else {    } else {
267      #die ("not a reference!");      #die ("not a reference!");
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.23
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed