File Coverage

blib/lib/Tags/Output/LibXML.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Tags::Output::LibXML;

# Pragmas.
use base qw(Tags::Output);
use strict;
use warnings;

# Modules.
use Error::Pure qw(err);
use Readonly;
use XML::LibXML;

# Constants.
Readonly::Scalar my $EMPTY_STR => q{};

# Version.
our $VERSION = 0.01;

# Flush tags in object.
sub flush {
	my ($self, $reset_flag) = @_;
	my $ret;
	my $ouf = $self->{'output_handler'};
	if ($ouf) {
		no warnings;
		print {$ouf} $self->{'doc'}->toString(
			$self->{'set_indent'} ? 2 : 0)
			or err 'Cannot write to output handler.';
	} else {
		$ret = $self->{'doc'}->toString(
			$self->{'set_indent'} ? 2 : 0);
	}

	# Reset.
	if ($reset_flag) {
		$self->reset;
	}

	return $ret;
}

# Resets internal variables.
sub reset {
	my $self = shift;

	# Root node.
	$self->{'doc'} = XML::LibXML::Document->new(
		$self->{'xml_version'},
		$self->{'encoding'},
	);

	# First node = root node.
	$self->{'first'} = 0;

	# Printed tags.
	$self->{'printed_tags'} = [];

	return;
}

# Check parameters to rigth values.
sub _check_params {
        my $self = shift;

	# Check to output handler.
	if (defined $self->{'output_handler'}
		&& ref $self->{'output_handler'} ne 'GLOB') {

		err 'Output handler is bad file handler.';
	}

	return;
}

# Default parameters.
sub _default_parameters {
	my $self = shift;

	# CDATA callback.
	$self->{'cdata_callback'} = undef;

	# Data callback.
	$self->{'data_callback'} = undef;

	# Document encoding.
	$self->{'encoding'} = 'UTF-8';

	# No simple tags.
	# TODO not implemented.
	$self->{'no_simple'} = [];

	# Set output handler.
	$self->{'output_handler'} = undef;

	# Preserved tags.
	# TODO not implemented.
	$self->{'preserved'} = [];

	# Set indent.
	$self->{'set_indent'} = 0;

	# Skip bad tags.
	$self->{'skip_bad_tags'} = 0;

	# XML version.
	$self->{'xml_version'} = '1.1';

	return;
}

# Attributes.
sub _put_attribute {
	my ($self, $attr, $value) = @_;
	$self->{'printed_tags'}->[0]->setAttribute($attr, $value);
	return;
}

# Begin of tag.
sub _put_begin_of_tag {
	my ($self, $tag) = @_;
	my $begin_node = $self->{'doc'}->createElement($tag);
	if ($self->{'first'} == 0) {
		$self->{'doc'}->setDocumentElement($begin_node);
		$self->{'first'} = 1;
	} else {
		if (! $self->{'printed_tags'}->[0]) {
			err "Second root tag '$tag' is bad.";
		} else {
			$self->{'printed_tags'}->[0]->addChild($begin_node);
		}
	}
	unshift @{$self->{'printed_tags'}}, $begin_node;
	return;
}

# CData.
sub _put_cdata {
	my ($self, @cdata) = @_;
	$self->_process_callback(\@cdata, 'cdata_callback');
	my $cdata = join($EMPTY_STR, @cdata);
	my $cdata_node = $self->{'doc'}->createCDATASection($cdata);
	$self->{'printed_tags'}->[0]->addChild($cdata_node);
	return;
}

# Comment.
sub _put_comment {
	my ($self, @comments) = @_;
	my $comment = join($EMPTY_STR, @comments);

	# HACK LibXML has a bug.
	if ($comment =~ m/-$/ms) {
		$comment .= ' ';
	}

	my $comment_node = $self->{'doc'}->createComment($comment);
	if (! defined $self->{'printed_tags'}->[0]) {
		$self->{'doc'}->appendChild($comment_node);
	} else {
		$self->{'printed_tags'}->[0]->addChild($comment_node);
	}
	return;
}

# Data.
sub _put_data {
	my ($self, @data) = @_;
	$self->_process_callback(\@data, 'data_callback');
	my $data = join($EMPTY_STR, @data);
	my $data_node = $self->{'doc'}->createTextNode($data);
	$self->{'printed_tags'}->[0]->addChild($data_node);
	return;
}

# End of tag.
sub _put_end_of_tag {
	my ($self, $tag) = @_;
	shift @{$self->{'printed_tags'}};
	return;
}

# Instruction.
sub _put_instruction {
	my ($self, $target, $code) = @_;
	my $instruction_node = $self->{'doc'}->createProcessingInstruction(
		$target, $code,
	);
	if (! defined $self->{'printed_tags'}->[0]) {
		$self->{'doc'}->appendChild($instruction_node);
	} else {
		$self->{'printed_tags'}->[0]->addChild($instruction_node);
	}
	return;
}

# Raw data.
sub _put_raw {
	my ($self, @raw_data) = @_;
	return;
}

1;

__END__