view release on metacpan or  search on metacpan

Bare.pm  view on Meta::CPAN

        if( $level > 1 ) { # $#dex < 4 && 
          if( $obj && $obj =~ /[<>&;]/ ) { $xml .= '<![CDATA[' . $obj . ']]>'; }
          else { $xml .= $obj if( $obj =~ /\S/ ); }
        }
      }
      elsif( $i =~ /^_/ ) {}
      else { $xml .= '<' . $i . '>' . $obj . '</' . $i . '>'; }
    }
  }
  my $pad2 = $imm ? '' : $pad;
  my $cr = $imm ? '' : "\n";
  if( substr( $name, 0, 1 ) ne '_' ) {
    if( $name ) {
      if( $xml ) {
        $xml = $pad . '<' . $name . $att . '>' . $cr . $xml . $pad2 . '</' . $name . '>';
      }
      else {
        $xml = $pad . '<' . $name . $att . ' />';
      }
    }
    return $xml."\n" if( $level > 1 );
    return $xml;
  }
  return '';
}

sub obj2html {
  my ( $objs, $name, $pad, $level, $pdex ) = @_;
    
  my $less = "<span class='ang'>&lt;</span>";
  my $more = "<span class='ang'>></span>";
  my $tn0 = "<span class='tname'>";
  my $tn1 = "</span>";
  my $eq0 = "<span class='eq'>";
  my $eq1 = "</span>";
  my $qo0 = "<span class='qo'>";
  my $qo1 = "</span>";
  my $sp0 = "<span class='sp'>";
  my $sp1 = "</span>";
  my $cd0 = "";
  my $cd1 = "";
  
  $level = 0 if( !$level );
  $pad = '' if( $level == 1 );
  my $xml  = '';
  my $att  = '';
  my $imm  = 1;
  return '' if( !$objs );
  my @dex = sort { 
    my $oba = $objs->{ $a };
    my $obb = $objs->{ $b };
    my $posa = 0;
    my $posb = 0;
    $oba = $oba->[0] if( ref( $oba ) eq 'ARRAY' );
    $obb = $obb->[0] if( ref( $obb ) eq 'ARRAY' );
    if( ref( $oba ) eq 'HASH' ) { $posa = $oba->{'_pos'} || 0; }
    if( ref( $obb ) eq 'HASH' ) { $posb = $obb->{'_pos'} || 0; }
    return $posa <=> $posb;
  } keys %$objs;
  
  if( $objs->{'_cdata'} ) {
    my $val = $objs->{'value'};
    $val =~ s/^(\s*\n)+//;
    $val =~ s/\s+$//;
    $val =~ s/&/&amp;/g;
    $val =~ s/</&lt;/g;
    $objs->{'value'} = $val;
    #$xml = "$less![CDATA[<div class='node'><div class='cdata'>$val</div></div>]]$more";
    $cd0 = "$less![CDATA[<div class='node'><div class='cdata'>";
    $cd1 = "</div></div>]]$more";
  }
  for my $i ( @dex ) {
    my $obj  = $objs->{ $i } || '';
    my $type = ref( $obj );
    if( $type eq 'ARRAY' ) {
      $imm = 0;
      
      my @dex2 = sort { 
        if( !$a ) { return 0; }
        if( !$b ) { return 0; }
        if( ref( $a ) eq 'HASH' && ref( $b ) eq 'HASH' ) {
          my $posa = $a->{'_pos'};
          my $posb = $b->{'_pos'};
          if( !$posa ) { $posa = 0; }
          if( !$posb ) { $posb = 0; }
          return $posa <=> $posb;
        }
        return 0;
      } @$obj;
      
      for my $j ( @dex2 ) { $xml .= obj2html( $j, $i, $pad.'&nbsp;&nbsp;', $level+1, $#dex ); }
    }
    elsif( $type eq 'HASH' && $i !~ /^_/ ) {
      if( $obj->{ '_att' } ) {
        my $val = $obj->{ 'value' };
        $val =~ s/</&lt;/g;
        if( $val eq '' ) {
          $att .= " <span class='aname'>$i</span>" if( $i !~ /^_/ );
        }
        else {
          $att .= " <span class='aname'>$i</span>$eq0=$eq1$qo0\"$qo1$val$qo0\"$qo1" if( $i !~ /^_/ );
        }
      }
      else {
        $imm = 0;
        $xml .= obj2html( $obj , $i, $pad.'&nbsp;&nbsp;', $level+1, $#dex );
      }
    }
    else {
      if( $i eq 'comment' ) { $xml .= "$less!--" . $obj . "--$more" . "<br>\n"; }
      elsif( $i eq 'value' ) {
        if( $level > 1 ) {
          if( $obj && $obj =~ /[<>&;]/ && ! $objs->{'_cdata'} ) { $xml .= "$less![CDATA[$obj]]$more"; }
          else { $xml .= $obj if( $obj =~ /\S/ ); }
        }
      }
      elsif( $i =~ /^_/ ) {}
      else { $xml .= "$less$tn0$i$tn1$more$obj$less/$tn0$i$tn1$more"; }
    }
  }
  my $pad2 = $imm ? '' : $pad;
  if( substr( $name, 0, 1 ) ne '_' ) {
    if( $name ) {
      if( $imm ) {
        if( $xml =~ /\S/ ) {
          $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att$more$cd0$xml$cd1$less/$tn0$name$tn1$more";
        }
        else {
          $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att/$more";
        }
      }
      else {
        if( $xml =~ /\S/ ) {
          $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att$more<div class='node'>$xml</div>$sp0$pad$sp1$less/$tn0$name$tn1$more";
        }
        else { $xml = "$sp0$pad$sp1$less$tn0$name$tn1$att/$more"; }
      }
    }
    $xml .= "<br>" if( $objs->{'_br'} );
    if( $objs->{'_note'} ) {
      $xml .= "<br>";
      my $note = $objs->{'_note'}{'value'};
      my @notes = split( /\|/, $note );
      for( @notes ) {
        $xml .= "<div class='note'>$sp0$pad$sp1<span class='com'>&lt;!--</span> $_ <span class='com'>--></span></div>";
      }
    }
    return $xml."<br>\n" if( $level );
    return $xml;
  }
  return '';
}

1;

__END__

=head1 SYNOPSIS

  use XML::Bare;
  
  my $ob = new XML::Bare( text => '<xml><name>Bob</name></xml>' );
  
  # Parse the xml into a hash tree
  my $root = $ob->parse();
  
  # Print the content of the name node
  print $root->{xml}->{name}->{value};
  
  ---
  
  # Load xml from a file ( assume same contents as first example )
  my $ob2 = new XML::Bare( file => 'test.xml' );