File Coverage

blib/lib/XML/LibXML/Debugging.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

package XML::LibXML::Debugging;

use 5.008;
use parent qw(XML::LibXML);
use strict;

use HTML::HTML5::Entities qw(encode_entities_numeric);
use XML::LibXML qw(:all);

BEGIN {
	$XML::LibXML::Debugging::AUTHORITY = 'cpan:TOBYINK';
	$XML::LibXML::Debugging::VERSION   = '0.103';
}

sub XML::LibXML::Document::toDebuggingHash
{
	my $n = shift;

	return {
		'type'   => 'Document',
		'root'   => $n->documentElement->toDebuggingHash,
		};
}

sub XML::LibXML::Document::toClarkML
{
	my $n = shift;
	$n->documentElement->toClarkML;
}

sub XML::LibXML::Element::toDebuggingHash
{
	my $n = shift;

	my $rv = {
		'type'    => 'Element',
		'qname'   => $n->nodeName,
		'prefix'  => $n->prefix,
		'suffix'  => $n->localname,
		'nsuri'   => $n->namespaceURI,
		'attributes' => [],
		'children'   => [],
		};

	foreach my $attr ($n->attributes)
	{
		my $x = $attr->toDebuggingHash;
		push @{ $rv->{'attributes'} }, $x if $x;
	}

	foreach my $kid ($n->childNodes)
	{
		if ($kid->nodeType == XML_TEXT_NODE
		||  $kid->nodeType == XML_CDATA_SECTION_NODE)
		{
			push @{ $rv->{'children'} }, $kid->nodeValue;
		}
		elsif ($kid->nodeType == XML_COMMENT_NODE)
		{
			push @{ $rv->{'children'} }, $kid->toDebuggingHash;
		}
		elsif ($kid->nodeType == XML_ELEMENT_NODE)
		{
			push @{ $rv->{'children'} }, $kid->toDebuggingHash;
		}
	}

	return $rv;
}

sub XML::LibXML::Element::toClarkML
{
	my $n = shift;

	my $rv;

	if (defined $n->namespaceURI)
	{
		$rv = sprintf("<{%s}%s", $n->namespaceURI, $n->localname);
	}
	else
	{
		$rv = sprintf("<%s", $n->localname);
	}

	foreach my $attr ($n->attributes)
	{
		my $x = $attr->toClarkML;
		$rv .= " $x" if $x;
	}

	if (! $n->childNodes)
	{
		return $rv . "/>";
	}

	$rv .= ">";

	foreach my $kid ($n->childNodes)
	{
		if ($kid->nodeType == XML_TEXT_NODE
		||  $kid->nodeType == XML_CDATA_SECTION_NODE)
		{
			$rv .= encode_entities_numeric($kid->nodeValue);
		}
		elsif ($kid->nodeType == XML_COMMENT_NODE)
		{
			$rv .= "";
		}
		elsif ($kid->nodeType == XML_ELEMENT_NODE)
		{
			$rv .= $kid->toClarkML;
		}
	}

	if (defined $n->namespaceURI)
	{
		$rv .= sprintf("", $n->namespaceURI, $n->localname);
	}
	else
	{
		$rv .= sprintf("", $n->localname);
	}

	return $rv;
}

sub XML::LibXML::Comment::toDebuggingHash
{
	my $n = shift;

	return {
		'type'    => 'Comment',
		'comment' => $n->nodeValue,
		};
}

sub XML::LibXML::Comment::toClarkML
{
	my $n = shift;
	return "";
}

sub XML::LibXML::Attr::toDebuggingHash
{
	my $n = shift;

	if ($n->nodeType == XML_NAMESPACE_DECL)
	{
		return {
			'type'    => 'Namespace Declaration',
			'qname'   => $n->nodeName,
			'prefix'  => $n->prefix,
			'suffix'  => $n->getLocalName,
			'nsuri'   => $n->getNamespaceURI,
			'value'   => $n->getData,
		};
	}

	return {
		'type'    => 'Attribute',
		'qname'   => $n->nodeName,
		'prefix'  => $n->prefix,
		'suffix'  => $n->localname,
		'nsuri'   => $n->namespaceURI,
		'value'   => $n->nodeValue,
		};
}

sub XML::LibXML::Attr::toClarkML
{
	my $n = shift;

	if ($n->nodeType == XML_NAMESPACE_DECL)
	{
		if (defined $n->getLocalName)
		{
			return sprintf("{%s}%s=\"%s\"",
				$n->getNamespaceURI, $n->getLocalName, $n->getData);
		}
		return sprintf("{%s}xmlns=\"%s\"",
			$n->getNamespaceURI, $n->getData);
	}

	if (defined $n->namespaceURI)
	{
		return sprintf("{%s}%s=\"%s\"",
			$n->namespaceURI, $n->localname, $n->nodeValue);
	}
	else
	{
		return sprintf("%s=\"%s\"",
			$n->localname, $n->nodeValue);
	}
}

sub XML::LibXML::Node::toClarkML
{
	return '';
}

sub XML::LibXML::Node::toDebuggingHash
{
	return {type=>'Node'};
}

sub XML::LibXML::Namespace::toClarkML
{
	return XML::LibXML::Attr::toClarkML(@_);
}

sub XML::LibXML::Namespace::toDebuggingHash
{
	return XML::LibXML::Attr::toDebuggingHash(@_);
}

1;

__END__