HTML-DOM

 view release on metacpan or  search on metacpan

t/html-dom.t

# ~~~ I need a test that makes sure HTML::TreeBuilder doesn’t spit out
#     warnings because of hash deref overloading.

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

use Test::More tests => reverse 54;


# -------------------------#
# Test 1: load the module

BEGIN { use_ok 'HTML::DOM'; }

# -------------------------#
# Tests 2-3: constructor

my $doc = new HTML::DOM;
isa_ok $doc, 'HTML::DOM';

# weaken_response
{
 require HTTP::Response;
 my $res = new HTTP::Response;
 my $doc = new HTML::DOM response => $res, weaken_response => 1;
 require Scalar'Util;
 Scalar'Util'weaken $res;
 is $res, undef, 'weaken_response';
}

# -------------------------#
# Tests 4-24: elem_handler, parse, eof and write

# It is important that this
# 18 May, 2010: I’ve just discovered the previous line, which I apparently
# wrote five months ago; but I have no idea what it was going to say.
$doc->elem_handler(script => sub {
	eval($_[1]->firstChild->data);
	$@ and die;
});

$doc->write(<<'-----');

<body><p>Para 1
<p>Para 2
<script type='application/x-perl'>
$doc->write('<p>Para ' . ($doc->body->childNodes->length+1))
</script>
<p>Para 4
<p>Para 5
<script type='application/x-perl'>
$doc->write('<p>Para ' . ($doc->body->childNodes->length+1))
</script>
</body>

-----

$doc->close;

{
	no warnings 'deprecated';
	local $[ = 1;
	use warnings 'deprecated';
	my @p_tags = $doc->body->childNodes;
	for(1..6){ 
		is $p_tags[$_]->tagName, 'P',
			"body\'s child node no. $_ is a P elem";
		isa_ok $p_tags[$_]->firstChild, 'HTML::DOM::Text',
			"first child of para $_";
		like $p_tags[$_]->firstChild->data, qr/Para $_\b/,
			"contents of para $_";
	}
}

{
 my $script = $doc->createElement('script');
 $script->appendChild($doc->createTextNode('$doc->title("scred")'));
 $doc->body->appendChild($script);
 is $doc->title, 'scred', "elem_handlers are triggered on node insertion";
}

{
 # Test that elements are accessible as soon as they are written (i.e.,
 # that write is not actually buffered, even though we call it that). This
 # was fixed in 0.040.
 $doc->write(<<' -----');
  <script>
   # This is based on a horrid piece of code at
   # http://www.tmxmoney.com/en/scripts/homepage.js
   $doc->write("<img id='img1' height='1' width='1'>");
   $doc->getElementById("img1")->src(
    "http://beacon.securestudies.com/scripts/beacon.dll?blah-blah-blah..."
   );
  </script>
 -----
 $doc->close;
 is $doc->find('img')->src,
   'http://beacon.securestudies.com/scripts/beacon.dll?blah-blah-blah...',
   'so-called buffered write is not actually buffered' 
}

{
 # Test that we don’t get errors when the document’s root element is
 # detached inside an elem handler just before a write.  Fixed in 0.051
 my$ h = new HTML::DOM;
 $h->elem_handler(script => sub { 
         $h->removeChild($h->firstChild); $h->write("foo") }
 );
 ok eval { $h->write("<script></script>"); 1 },
  'no error from writing inside an elem handler when there is no doc root';
}

# -------------------------#
# Tests 25-37: parse_file & charset

use File::Basename;
use File::Spec::Functions 'catfile';

is $doc->charset, undef, 'undefined charset';
ok +($doc = new HTML::DOM) # clobber the existing one
   ->parse_file(catfile(dirname ($0),'test.html')),
	'parse_file returns true';

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.475093 second using v1.00-cache-1.03-grep-7fa205e-cpan-6421e59f23b )