HTML-DOM
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
t/html-dom.t view on Meta::CPAN
# ~~~ 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 release on metacpan - search on metacpan
( run in 0.475 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )