view release on metacpan or  search on metacpan

basiclib/XML/Smart/Data.pm-txt  view on Meta::CPAN

        if ( tied($$tree{$Key}) && $$tree{$Key} =~ /\S/s ) {
          $ident = '' ; $stat[1] += 2 ;
        }
        next if tied($$tree{$Key}) ;
        
        if ( $$tree{$Key} ne '' ) {
          my $p0 = length($tags) ;
          $tags .= $$tree{$Key} ;        
          $cont = [$p0,length($tags)] ;
        }
      }
      elsif ($Key =~ /^\/\.CONTENT\/\d+$/) { $tags .= $$tree{$Key} ;}
      elsif ( $stat[4] && $$tree{$Key} eq '') { $args_end .= " $Key" ;}
      else {
        my $tp = _data_type($$tree{$Key}) ;
        if    ($tp == 1) {
          my $k = $stat[4] ? $Key : &_check_key($Key) ;
          if    ($stat[3] == 1) { $k = "\L$Key\E" ;}
          elsif ($stat[3] == 2) { $k = "\U$Key\E" ;}
          $args .= " $k=" . &_add_quote($$tree{$Key}) ;
        }
        else {
          my $k = $stat[4] ? $Key : &_check_key($Key) ;
          if    ($stat[2] == 1) { $k = "\L$Key\E" ;}
          elsif ($stat[2] == 2) { $k = "\U$Key\E" ;}

          if ($tp == 2) {
            my $cont = $$tree{$Key} ; &_add_basic_entity($cont) ;
            $tags .= qq`$ident<$k>$cont</$k>` ;
          }
          elsif ($tp == 3) { $tags .= qq`$ident<$k><![CDATA[$$tree{$Key}]]></$k>`;}
          elsif ($tp == 4) {
            require XML::Smart::Base64 ;
            my $base64 = &XML::Smart::Base64::encode_base64($$tree{$Key}) ;
            $base64 =~ s/\s$//s ;
            $tags .= qq`$ident<$k dt:dt="binary.base64">$base64</$k>`;
          }
        }
      }
    }
    
    foreach my $Key ( keys %array_i ) {
      if ( $array_i{$Key} ne 'ok' && $#{ $$tree{$Key} } >= $array_i{$Key} ) {
        for my $i ( $array_i{$Key} .. $#{ $$tree{$Key} } ) {
          my $k = $$tree{$Key}[$i] ;
          $args .= &_data(\$tags,$k,$Key, $level+1 , $tree , $parsed , undef , undef , @stat) ;
        }
      }
    }
    
    if ( $cont ne '' ) {
      my ( $po , $p1 ) = @$cont ;
      my $cont = substr($tags , $po , $p1) ;
        
      my $tp = _data_type($cont) ;
      
      if ( $node_type =~ /^(\w+),(\d+),(\d*)$/ ) {
        my ( $node_tp , $node_set ) = ($1,$2) ;

        if ( !$node_set ) {
          if    ( $tp == 3 && $node_tp eq 'cdata'  ) { $tp = 0 ;}
          elsif ( $tp == 4 && $node_tp eq 'binary' ) { $tp = 0 ;}
        }
        else {
          if    ( $node_tp eq 'cdata'  ) { $tp = 3 ;}
          elsif ( $node_tp eq 'binary' ) { $tp = 4 ;}
        }
      }
      
      if ( $tp == 3 ) { $cont = "<![CDATA[$cont]]>" ;}
      elsif ( $tp == 4 ) {
        require XML::Smart::Base64 ;
        $cont = &XML::Smart::Base64::encode_base64($cont) ;
        $cont =~ s/\s$//s ;
        $args .= ' dt:dt="binary.base64"' ;
      }
      else { &_add_basic_entity($cont) ;}
      
      my $px = $p1 ;
      while( substr($tags , $px , 1) =~ /\s/ ) { ++$px ;}
      
      if ( $px > $p1 ) { substr($tags , $p1 , $px-$p1) = '' ;}
      
      substr($tags , $po , $p1) = $cont ;
    }
    
    ##print "***$tag>> $args,$args_end,$tags,$cont,$stat_1 [@all_keys]\n" ;
    
    if ($args_end ne '') {
      $args .= $args_end ;
      $args_end = undef ;
    }

    if (!@all_keys) {
      $$data .= qq`$ident<$tag/>` if $tag ne '' ;
    }
    elsif ($args ne '' && $tags ne '') {
      $$data .= qq`$ident<$tag$args>` if $tag ne '' ;
      $$data .= $tags ;
      $$data .= $ident if !$cont ;
      $$data .= qq`</$tag>` if $tag ne '' ;
    }
    elsif ($args ne '') {
      $$data .= qq`$ident<$tag$args/>`;
    }
    elsif ($tags ne '') {
      $$data .= qq`$ident<$tag>` if $tag ne '' ;
      $$data .= $tags ;
      $$data .= $ident if !$cont ;
      $$data .= qq`</$tag>` if $tag ne '' ;
    }
    else {
      $$data .= qq`$ident<$tag></$tag>` if $tag ne '' ;
    }
  }
  elsif (ref($tree) eq 'ARRAY') {
    my ($c,$v,$tags) ;

    my $i = -1 ;
    foreach my $value_i (@$tree) {
      
      if ( $ar_i ne '' ) {
        ++$i ;
        next if $i != $ar_i ;
      }
      
      my $value = $value_i ;
      if (ref $value_i eq 'XML::Smart') { $value = $$value_i->{point} ;}
      
      my $do_val = 1 ;
      if ( $tag_org eq '!--' && ( !ref($value) || ( ref($value) eq 'HASH' && keys %{$value} == 1 && (defined $$value{CONTENT} || defined $$value{content}) ) ) ) {
        $c++ ;
        my $ct = $value ;
        if (ref $value) { $ct = defined $$value{CONTENT} ? $$value{CONTENT} : $$value{content} ;} ;
        $tags .= $ident . '<!--' . $ct . '-->' ;
        $v = $ct if $c == 1 ;
        $do_val = 0 ;
      }
      elsif (ref($value)) {
        if (ref($value) eq 'HASH') {
          $c = 2 ;
          &_data(\$tags,$value,$tag,$level, $tree , $parsed , undef , undef , @stat) ;
          $do_val = 0 ;
        }
        elsif (ref($value) eq 'SCALAR') { $value = $$value ;}
        elsif (ref($value) ne 'ARRAY') { $value = "$value" ;}
      }
      if ( $do_val && $value ne '') {
        my $tp = _data_type($value) ;
        
        if ( $node_type =~ /^(\w+),(\d+),(\d*)$/ ) {
          my ( $node_tp , $node_set ) = ($1,$2) ;
          if ( !$node_set ) {
            if    ( $tp == 3 && $node_tp eq 'cdata'  ) { $tp = 0 ;}
            elsif ( $tp == 4 && $node_tp eq 'binary' ) { $tp = 0 ;}
          }
          else {
            if    ( $node_tp eq 'cdata'  ) { $tp = 3 ;}
            elsif ( $node_tp eq 'binary' ) { $tp = 4 ;}
          }
        }
        
        if ($tp <= 2) {
          $c++ ;
          my $cont = $value ; &_add_basic_entity($value) ;
          &_add_basic_entity($cont) ;
          $tags .= qq`$ident<$tag>$cont</$tag>`;
          $v = $cont if $c == 1 ;
        }
        elsif ($tp == 3) {
          $c++ ;
          $tags .= qq`$ident<$tag><![CDATA[$value]]></$tag>`;
          $v = $value if $c == 1 ;
        }
        elsif ($tp == 4) {
          $c++ ;
          require XML::Smart::Base64 ;
          my $base64 = &XML::Smart::Base64::encode_base64($value) ;
          $base64 =~ s/\s$//s ;
          $tags .= qq`$ident<$tag dt:dt="binary.base64">$base64</$tag>`;
          $v = $value if $c == 1 ;
        }
      }
    }

    if ( $ar_i eq '' && $c <= 1 && ! $$prev_tree{'/nodes'}{$tag}) {
      my $k = $stat[4] ? $tag : &_check_key($tag) ;
      if    ($stat[3] == 1) { $k = "\L$k\E" ;}
      elsif ($stat[3] == 2) { $k = "\U$k\E" ;}
      delete $$parsed{"$tree"} if ref($tree) ;
      return " $k=" . &_add_quote($v) ;
    }
    else { $$data .= $tags ;}
  }
  elsif (ref($tree) eq 'SCALAR') {
    my $k = $stat[4] ? $tag : &_check_key($tag) ;
    if    ($stat[3] == 1) { $k = "\L$k\E" ;}
    elsif ($stat[3] == 2) { $k = "\U$k\E" ;}
    delete $$parsed{"$tree"} if ref($tree) ;
    return " $k=" . &_add_quote($$tree) ;
  }
  elsif (ref($tree)) {
    my $k = $stat[4] ? $tag : &_check_key($tag) ;
    if    ($stat[3] == 1) { $k = "\L$k\E" ;}
    elsif ($stat[3] == 2) { $k = "\U$k\E" ;}
    delete $$parsed{"$tree"} if ref($tree) ;
    return " $k=" . &_add_quote("$tree") ;
  }
  else {
    my $k = $stat[4] ? $tag : &_check_key($tag) ;
    if    ($stat[3] == 1) { $k = "\L$k\E" ;}
    elsif ($stat[3] == 2) { $k = "\U$k\E" ;}
    delete $$parsed{"$tree"} if ref($tree) ;
    return " $k=" . &_add_quote($tree) ;
  }

  delete $$parsed{"$tree"} if ref($tree) ;
  return ;