File Coverage

blib/lib/BW/XML/Out.pm

Criterion	Covered	Total	%
statement	12	71	16.9
branch	0	34	0.0
condition	0	7	0.0
subroutine	4	12	33.3
pod	4	6	66.6
total	20	130	15.3

# BW::XML::Out.pm
# Simple XML output
#
# by Bill Weinman - http://bw.org/
# Copyright (c) 1995-2010 The BearHeart Group, LLC
#
# See POD for History
#
package BW::XML::Out;
use strict;
use warnings;

use BW::Constants;
use base qw( BW::Base );

our $VERSION = "1.4";
sub version { $VERSION }

sub _init
{
    my $self = shift;
    $self->SUPER::_init(@_);

    $self->indent_mul(2) unless $self->{indent_mul};  # default to 2 spaces of indentation

    return SUCCESS;
}

# _setter_getter entry points
sub indent_mul   { BW::Base::_setter_getter(@_); }
sub indent_level { BW::Base::_setter_getter(@_); }

sub element
{
    my $sn = 'element';
    my ( $self, $element, $content, $options ) = @_;
    my $a            = '';
    my $attribs      = '';
    my $flags        = {};
    my $indent_level = $self->indent_level() || 0;

    $options = {} unless $options;

    $content = '' unless defined $content;
    $content = $self->xml_escape($content) if ( $content and not $options->{xmlContent} );

    if ($options) {
        if ( $options->{indentLevel} ) {
            $indent_level = $options->{indentLevel};
        }
        if ( $options->{indent} ) {
            ++$indent_level;
        }
        if ( $options->{startTag} ) {
            $flags->{start} = TRUE;
        } elsif ( $options->{endTag} ) {
            $flags->{end} = TRUE;
            --$indent_level;
        } elsif ( $options->{emptyTag} ) {
            $flags->{empty} = TRUE;
        }

        if ( $options->{attribs} ) {
            my @ats = @{ $options->{attribs} };
            foreach my $att (@ats) {
                my @att  = %$att;
                my $a_lh = $self->xml_escape( $att[0] );
                my $a_rh = $self->xml_escape( $att[1] );
                $attribs .= qq{ ${a_lh}="${a_rh}"};
            }
        }
    }

    # create the indent
    $a .= ' ' x ( $indent_level * $self->indent_mul() );

    if ( $flags->{empty} ) {
        $a .= qq{<${element}${attribs} />};
    } elsif ( $flags->{start} ) {
        $a .= qq{<${element}${attribs}>};
    } elsif ( $flags->{end} ) {
        $a .= qq{};
    } else {
        $a .= qq{<${element}${attribs}>${content}};
    }

    # terminate the element with a newline
    $a .= "\n" unless $options->{noNewline};

    if ( $options->{startTag} ) {
        ++$indent_level;
    }

    # keep the indent level
    $self->indent_level($indent_level);

    return $a;
}

sub xml_escape
{
    my ( $self, $c ) = @_;
    return '' unless defined $c;
    $c =~ s/&/&/gsm;
    $c =~ s/
    $c =~ s/>/>/gsm;
    $c =~ s/"/"/g;

    return $c;
}

# set the error string and return FAILURE
sub _error
{
    my $self = shift;
    $self->{error} = "$self->{me}: " . ( shift || 'unknown error' );
    return FAILURE;
}

# get and clear error string
sub error
{
    my $self   = shift;
    my $errstr = $self->{error};
    $self->{error} = VOID;
    return $errstr;
}

1;

__END__