#!/usr/bin/perl -T

# This script tests the Node interface. Since objects are never blessed
# into the HTML::DOM::Node class (it does have a 'new' method,  but you
# won't tell anyone, will you?), I am using a document fragment to test
# most of the interface.  The DocumentFragment interface  (supposedly)
# doesn't have any methods of its own,  but only those  in  inherits
# from Node.

# There are also tests in here for HTML::Element’s methods that are over-
# ridden by HTML::DOM::Node.

use strict; use warnings; use lib 't';

use Test::More tests => scalar reverse '801';


# -------------------------#
# Tests 1-2: load the modules

BEGIN { use_ok 'HTML::DOM'; }
BEGIN { &use_ok(qw'HTML::DOM::Node :all'); } # & so I can use qw

# -------------------------#
# Tests 3-14: constants

{
	my $x;

	for (qw/ ELEMENT_NODE ATTRIBUTE_NODE TEXT_NODE CDATA_SECTION_NODE
	        ENTITY_REFERENCE_NODE ENTITY_NODE
	      PROCESSING_INSTRUCTION_NODE COMMENT_NODE DOCUMENT_NODE
	   DOCUMENT_TYPE_NODE DOCUMENT_FRAGMENT_NODE NOTATION_NODE /) {
		eval "is $_, " . ++$x . ", '$_'";
	}
}



# -------------------------#
# Tests 15-17: constructor

my $doc = new HTML::DOM; $doc->open;
isa_ok $doc, 'HTML::DOM';
my $frag = $doc->createDocumentFragment;
isa_ok $frag, 'HTML::DOM::DocumentFragment';
isa_ok $frag, 'HTML::DOM::Node'; # make sure it's node we're testing

my $another_doc = new HTML::DOM; # we need this in various places

# -------------------------#
# Tests 18-35: attributes

# wq/nodeName nodeValue nodeType/ are implemented by subclasses

{
	isa_ok my $root_elem = $doc->documentElement, 'HTML::DOM::Node';
		# just to make sure we're testing the node interface
	cmp_ok $root_elem->parentNode, '==', $doc, 'parentNode';
}

is_deeply [  childNodes $frag ], [], 'no childNodes in list context';
is_deeply [@{childNodes $frag}], [], 'no childNodes in scalar context';
is_deeply [  firstChild $frag ], [], 'firstChild is null';
is_deeply [   lastChild $frag ], [], 'lastChild is null';

# Next we'll give our doc frag a few child nodes to play withal (and we'll
# need to do this later, too, so it's in a subroutine).
sub fill_frag($) {
	my $frag = shift;
	(my $child = createElement $doc 'div')->id('wunne');
	appendChild $frag $child;
	(   $child = createElement $doc 'div')->id('tioux');
	appendChild $frag $child;
	(   $child = createElement $doc 'div')->id('three');
	appendChild $frag $child;
}
fill_frag $frag;

is_deeply [map id $_, childNodes $frag], [qw/ wunne tioux three /],
	'childNodes in list context';
is_deeply [map id $_, @{childNodes $frag}], [qw/ wunne tioux three /],
	'childNodes in scalar context';

is id{firstChild $frag}, 'wunne', 'firstChild';
is id{ lastChild $frag}, 'three',  'lastChild';

is_deeply [previousSibling $frag], [], 'null previousSibling';
is_deeply [nextSibling $frag], [], 'null nextSibling';

# make sure we're testing node methods
cmp_ok firstChild $frag ->can('nextSibling'), '==',
	HTML::DOM::Node->can('nextSibling'),
	'we\'re testing the right nextSibling';
cmp_ok childNodes $frag ->[1]->can('previousSibling'), '==',
	HTML::DOM::Node->can('previousSibling'),
	'we\'re testing the right previousSibling';

is id{nextSibling{(childNodes $frag)[0]}}, 'tioux', 'nextSibling';
is id{previousSibling{(childNodes $frag)[1]}}, 'wunne', 'previousSibling';

is_deeply [attributes $frag], [], 'attributes';

cmp_ok ownerDocument $frag, '==', $doc, 'ownerDocument';


# -------------------------#
# Tests 36-47: insertBefore

{
	$frag->insertBefore(my $elem = $doc->createElement('div'));
	$elem ->id('phour');
	is_deeply [map id $_, childNodes $frag],
		[qw/wunne tioux three phour/],
		'insertBefore with a null 2nd arg';

	$frag->insertBefore((childNodes $frag)[-1,0]);
	is_deeply [map id $_, childNodes $frag],
		[qw/phour wunne tioux three/],
		'insertBefore removes from the tree first';

	$elem = createElement $doc 'p';
	$elem->insertBefore($frag);
	is_deeply [map id $_, childNodes $elem],
		[qw/phour wunne tioux three/],
		'insertBefore(frag) inserts the frag\'s children';

	SKIP :{
		skip 'not implemented yet', 2;
		eval {
			$frag->insertBefore(
				createAttribute $doc 'ddk'
			);
		};
		isa_ok $@, 'HTML::DOM::Exception',
			'$@ (after insertBefore with wrong node type)';
		cmp_ok $@, '==', 
			HTML::DOM::Exception::HIERARCHY_REQUEST_ERR,
			'insertBefore with wrong node type throws a ' .
			'hierarchy error';
	}
	
	eval {
		($elem->childNodes)[0]->insertBefore(
			$elem
		);
	};
	isa_ok $@, 'HTML::DOM::Exception',
		'$@ (after insertBefore with an ancestor node)';
	cmp_ok $@, '==', HTML::DOM::Exception::HIERARCHY_REQUEST_ERR,
	    'insertBefore with an ancestor node throws a hierarchy error';

	my $other_elem = createElement $another_doc 'ddk';
	ok eval {
		$frag->insertBefore(
			$other_elem
		);
		1
	}, 'insertBefore with wrong doc no longer dies';
	is $other_elem->ownerDocument, $frag->ownerDocument,
	 'insertBefore with wrong doc sets the owner doc';

	eval {
		$frag->insertBefore(
			$doc->createElement('ddk'), $elem
		);
	};
	isa_ok $@, 'HTML::DOM::Exception',
		'$@ (after insertBefore with a bad refChild)';
	cmp_ok $@, '==', HTML::DOM::Exception::NOT_FOUND_ERR,
		'insertBefore with a 2nd arg that\'s not a child of ' .
		'this node throws a "not found" error';

	# We need to make sure that $doc->insertBefore doesn’t throw a
	# wrong doc error, due to $doc’s ownerDocument’s being null.
	my $dock = new HTML::DOM;
	ok eval{
	    $dock->insertBefore($dock->createComment('unoeunoth'),undef); 1
	}, '$doc->insertBefore doesn’t produce an invalid wrong doc error'
	  or diag $@;
}

# -------------------------#
# Tests 48-60: replaceChild

# insertBefore messed up our frag, so let's make a new one.
fill_frag($frag = createDocumentFragment $doc);

{
	is id{$frag->replaceChild((childNodes $frag)[0,2])}, 'three',
		'replaceChild returns the replaced node';
	is_deeply [map id $_, childNodes $frag],
		[qw/tioux wunne/],
		'replaceChild removes from the tree first';

	(my $elem = createElement $doc 'p')->appendChild(
		my $node = createTextNode $doc 'lalala');
	$elem->replaceChild($frag, $node);
	is_deeply [map id $_, childNodes $elem],
		[qw/tioux wunne/],
		'replaceChild(frag,node) inserts the frag\'s children';

	SKIP :{
		skip 'not implemented yet', 2;
		eval {
			$frag->appendChild(
				my $node = createTextNode $doc 'ooo');
			$frag->replaceChild(
				(createAttribute $doc 'ddk'), $node
			);
		};
		isa_ok $@, 'HTML::DOM::Exception',
			'$@ (after replaceChild with wrong node type)';
		cmp_ok $@, '==',
			HTML::DOM::Exception::HIERARCHY_REQUEST_ERR,
			'replaceChild with wrong node type throws a ' .
			'hierarchy error';
	}
	
	eval {
		(my $node = ($elem->childNodes)[0])->appendChild(
			my $text_node = createTextNode $doc 'oetot');
		$node->replaceChild(
			$elem, $text_node
		);
	};
	isa_ok $@, 'HTML::DOM::Exception',
		'$@ (after replaceChild with an ancestor node)';
	cmp_ok $@, '==', HTML::DOM::Exception::HIERARCHY_REQUEST_ERR,
	    'replaceChild with an ancestor node throws a hierarchy error';

	my $other_elem = createElement $another_doc 'ddk';
	ok eval {
		$elem->replaceChild(
			($other_elem),
			(childNodes $elem)[0],
		);
		1
	}, 'replaceChild with wrong doc no longer dies';
	is $other_elem->ownerDocument, $elem->ownerDocument,
	 'replaceChild with wrong doc sets the owner doc';

	eval {
		$frag-> replaceChild(
			$doc->createElement('ddk'), $elem
		);
	};
	isa_ok $@, 'HTML::DOM::Exception',
		'$@ (after replaceChild with a bad refChild)';
	cmp_ok $@, '==', HTML::DOM::Exception::NOT_FOUND_ERR,
		'replaceChild with a 2nd arg that\'s not a child of ' .
		'this node throws a "not found" error';

	my $dock = new HTML::DOM; $dock->open;
	$dock->close; # avoid messing up the parser with this test
	ok eval{
	    $dock->replaceChild(
		$dock->createElement('html'),$dock->firstChild
	    ); 1
	}, '$doc->replaceChild doesn’t produce an invalid wrong doc error'
	 or diag $@;

	$dock->write('<p id=foo><a></a></p>');
	is $dock->getElementById('foo')->replaceChild(
		$dock->createElement('b'),
		$dock->getElementsByTagName('a')->[0]
	)->ownerDocument, $dock,
		'implicit ownerDocument is made explicit by replaceChild';
	
}

# -------------------------#
# Tests 61-6: removeChild

# replaceChild messed up our frag, so let's make a new one.
fill_frag($frag = createDocumentFragment $doc);

{
	is id{$frag->removeChild((childNodes $frag)[0])}, 'wunne',
		'removeChild returns the removed node';
	is_deeply [map id $_, childNodes $frag],
		[qw/tioux three/],
		'removeChild removes the node';

	eval {
		$frag-> removeChild(
			$doc->createElement('br')
		);
	};
	isa_ok $@, 'HTML::DOM::Exception',
		'$@ (after removeChild with a bad arg)';
	cmp_ok $@, '==', HTML::DOM::Exception::NOT_FOUND_ERR,
		'removeChild with an arg that\'s not a child of ' .
		'this node throws a "not found" error';

	(my $dock = new HTML::DOM)->write("<p id=foo><b id=bar></b></p>");
	is $dock->getElementById('foo')->removeChild(
		$dock->getElementById('bar')
	)->ownerDocument, $dock,
		'implicit ownerDocument is made explicit by removeChild';
	
	ok eval{$dock->removeChild($dock->firstChild)},
		'$doc->removeChild doesn\'t kick the bucket';
}

# -------------------------#
# Tests 67-76: appendChild

# removeChild messed up our frag, so let's make a new one.
fill_frag($frag = createDocumentFragment $doc);

{
	is id{$frag-> appendChild((childNodes $frag)[0])}, 'wunne',
		'appendChild returns the added node';
	is_deeply [map id $_, childNodes $frag],
		[qw/tioux three wunne/],
		'appendChild removes from the tree first';

	(my $elem = createElement $doc 'p')->appendChild($frag);
	is_deeply [map id $_, childNodes $elem],
		[qw/tioux three wunne/],
		'appendChild(frag) inserts the frag\'s children';

	SKIP :{
		skip 'not implemented yet', 2;
		eval {
			$frag-> appendChild(
				(createAttribute $doc 'ddk')
			);
		};
		isa_ok $@, 'HTML::DOM::Exception',
			'$@ (after appendChild with wrong node type)';
		cmp_ok $@, '==',
			HTML::DOM::Exception::HIERARCHY_REQUEST_ERR,
			'appendChild with wrong node type throws a ' .
			'hierarchy error';
	}
	
	eval {
		appendChild{($elem->childNodes)[0]}$elem
	};
	isa_ok $@, 'HTML::DOM::Exception',
		'$@ (after appendChild with an ancestor node)';
	cmp_ok $@, '==', HTML::DOM::Exception::HIERARCHY_REQUEST_ERR,
	    'appendChild with an ancestor node throws a hierarchy error';

	my $other_elem = createElement $another_doc 'ddk';
	ok eval {
		$elem-> appendChild($other_elem);
	}, 'appendChild with wrong doc no longer dies';
	is $other_elem->ownerDocument, $elem->ownerDocument,
	 'appendChild with wrong doc sets the owner doc';

	my $dock = new HTML::DOM;
	ok eval{
	    $dock->appendChild(
		$dock->createComment('html'),undef
	    ); 1
	}, '$doc->appendChild doesn’t produce an invalid wrong doc error';
}

# -------------------------#
# Tests 77-8: hasChildNodes

$frag = createDocumentFragment $doc;

ok !hasChildNodes $frag, '!hasChildNodes';
$frag->appendChild(createTextNode $doc 'eoteuht');
ok  hasChildNodes $frag, 'hasChildNodes';

# -------------------------#
# Tests 79-91: cloneNode

use Scalar::Util 'refaddr';
{
	$frag->appendChild(my $clonee = $doc->createElement('div'));
	$clonee->appendChild(
		my $childelem = $doc->createElement('p'));
	$clonee->setAttribute('style' => 'color:black');
	$childelem->setAttribute('align' => 'left');
	my $attr = $clonee->getAttributeNode('style');
	my $childattr = $childelem->getAttributeNode('align');

	my $clone = cloneNode $clonee; # shallow

	cmp_ok $clonee, '!=', $clone, 'cloneNode makes a new object';
	cmp_ok +()=childNodes $clone, '==', 0,
		'shallow clone works';
	is_deeply [parentNode $clone], [], 'clones are orphans';
	cmp_ok +attributes $clone, '!=', attributes $clonee,
		'the attributes map is cloned during a shallow clone';
	cmp_ok refaddr $clone->getAttributeNode('style'), '!=',
	       refaddr $attr, 'attributes are cloned';
	
	$clone = cloneNode $clonee 1; # deep
	
	cmp_ok $clonee, '!=', $clone, 'deep cloneNode makes a new object';
	cmp_ok +(childNodes $clonee)[0], '!=', (childNodes $clone)[0],
		'deep clone works';
	is_deeply [parentNode $clone], [], 'deep clones are parentless';
	cmp_ok +attributes $clone, '!=', attributes $clonee,
		'the attributes map is cloned during a deep clone';
	cmp_ok refaddr $clone->getAttributeNode('style'), '!=',
	       refaddr $attr, 'deep clone clones attributes...';
	cmp_ok refaddr $clone->firstChild->getAttributeNode('align'), '!=',
	       refaddr $childattr, '...recursively';

	# Test that cloneNode sets the ownerDocument properly.
	# We have to set it up this way, as it’s only parser-generated ele-
	# ments that do not already explicitly reference their documents.
	# And then we have to do it twice, as the first clone sets it.
	my $div = $doc->createElement('div');
	$div->innerHTML("<input>");
	$clonee = $div->firstChild;
	is cloneNode $clonee->ownerDocument, $doc,
	 'shallow cloneNode sets the ownerDocument';
	$div->innerHTML("<input>");
	$clonee = $div->firstChild;
	is cloneNode $clonee 1=>->ownerDocument, $doc,
	 'deep cloneNode sets the ownerDocument';
}

# -------------------------#
# Tests 92-5: as_text and as_HTML

{
	my $element = $doc->createElement('p');
	$element->getAttribute('dir'); # make sure implied attributes don't
	                               # affect serialisation when accessed
	$element->appendChild($doc->createTextNode('This text contains '));
	$element->appendChild(my $belem = $doc->createElement('tt'));
	$belem->appendChild($doc->createTextNode('<tags>'));
	$element->appendChild($doc->createTextNode('.'));
	$element->appendChild($doc->createComment('<no comment>'));

	is $element->as_text, 'This text contains <tags>.', 'as_text';
	like $element->as_HTML,
	   qr\^<p>This text contains <tt>&lt;tags&gt;</tt>.(?x:
              )<!--<no comment>-->$\,
	   "as_HTML";

	# We forgot to pass the arguments to the superclass in releases
	# prior to 0.032.
	like $element->as_HTML((undef)x2,{}),
	     qr\^<p>This text contains <tt>&lt;tags&gt;</tt>.(?x:
	        )<!--<no comment>--></p>$\,
	   "as_HTML with args";
	$belem->tag('del');
	is $element->as_text(skip_dels => 1), "This text contains .",
	 'as_text with args';
}


# -------------------------#
# Tests 96-9: normalize

{
	my $element = $doc->createElement('p');
	$element->appendChild($doc->createTextNode(''));
	$element->appendChild($doc->createTextNode('This text is '));
	$element->appendChild($doc->createTextNode('made up of '));
	$element->appendChild($doc->createTextNode('three adjacent '));
	$element->appendChild($doc->createTextNode(''));
	$element->appendChild($doc->createTextNode('text nodes, if I '));
	$element->appendChild($doc->createTextNode('counted them '));
	$element->appendChild($doc->createTextNode('correctly.'));

	is +()=$element->normalize, 0, 'ret val of normal eyes';
	is $element->childNodes->length, 1,
		'number of text nodes after normal eyes ’ay shone';
	is $element->firstChild->data, 'This text is made up of three ' . 
	                              'adjacent text nodes, if I ' .
	                            'counted them correctly.',
		'resulting text after normalisation';

	$element->replaceChild($doc->createTextNode(''),
		$element->firstChild);
	$element->normalize;
	
	ok !$element->hasChildNodes,
		'normal eyes obliterate lone blank text nodes';
}

# -------------------------#
# Tests 100-2: XML namespace stuff

is +()=$frag->$_, 0, $_ for qw / namespaceURI prefix localName /;

# -------------------------#
# Tests 103-5: hasAttributes

ok !$frag->hasAttributes, 'hasAttributes (non-Element node)';
{
	my $elem = $doc->createElement('a');
	ok !$elem->hasAttributes, 'hasAttributes when an elem has none';
	$elem->attr('foo','bar');
	ok $elem->hasAttributes, 'hasAttributes returning true';
}

# -------------------------#
# Tests 106-7: isSupported

ok $frag->isSupported('hTML', '1.0'), 'isSupported';
ok!$frag->isSupported('onfun') ,'isn’tSupported';

# -------------------------#
# Test 108: push_content on an empty node

ok eval{$doc->createElement('foo')->push_content()},
	'push_content with no args on an empty node doesn\'t die';
	# broken in 0.012; fixed in 0.017