File Coverage

lib/MKDoc/XML/TreePrinter.pm

Criterion	Covered	Total	%
statement	46	47	97.8
branch	15	18	83.3
condition	2	3	66.6
subroutine	4	4	100.0
pod	0	1	0.0
total	67	73	91.7

# -------------------------------------------------------------------------------------
# MKDoc::XML::TreePrinter
# -------------------------------------------------------------------------------------
# Author : Jean-Michel Hiver.
# Copyright : (c) MKDoc Holdings Ltd, 2003
#
# This module is the counterpart of MKDoc::XML::TreePrinter. It turns an XML
# tree back into a string.
#
# This module is distributed under the same license as Perl itself.
# -------------------------------------------------------------------------------------
package MKDoc::XML::TreePrinter;
use warnings;
use strict;


##
# $class->process (@nodes);
# ----------------------------
# Does the stuff.
##
sub process
{
    my $class  = shift;
    my @nodes  = @_;
    my @res = ();

    foreach my $node (@nodes)
    {
        ref $node or do {
            push @res, $node;
            next;
        };

        $node->{_tag} =~ /\~pi/ and do {
            push @res, "{text}?>";
            next;
        };

        $node->{_tag} =~ /\~declaration/ and do {
            push @res, "{text}>";
            next;
        };

        $node->{_tag} =~ /\~comment/ and do {
            push @res, "";
            next;
        };

        my $tag   = $node->{_tag};
        my %att   = map { $_ => _encode_quot ($node->{$_}) } grep !/^_/, keys %{$node};
        my $attr  = join " ", map { "$_=\"$att{$_}\"" } keys %att;
        my $open  = $node->{_open};
        my $close = $node->{_close};

        $open && $close && do {
            if ($attr) { push @res, "<$tag $attr />" }
            else       { push @res, "<$tag />"       }
            next;
        };

        my $open_tag  = $attr ? "<$tag $attr>" : "<$tag>";
        my $close_tag = "";
        my @desc      = $node->{_content} ? @{$node->{_content}} : ();

        my $res = $open_tag . $class->process (@desc) . $close_tag;
        push @res, $res;
        next;
    };

    return join '', @res;
}


sub _encode_quot
{
    my $res = shift;
    return '' unless (defined $res);

    $res =~ s/\"/\"\;/g;
    return $res;
}


1;


__END__