#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 24;
#use Test::More 'no_plan';
my $CLASS;
BEGIN {
chdir 't' if -d 't';
unshift @INC => '../lib';
$CLASS = 'HTML::TokeParser::Simple';
use_ok($CLASS) || die;
}
my $p = $CLASS->new(\*DATA);
my $token;
do { $token = $p->get_token } until $token->is_end_tag('head');
can_ok($token, 'set_attr');
do { $token = $p->get_token } until $token->is_start_tag('body');
can_ok($token, 'set_attr');
$token->set_attr(foo => 'bar');
is($token->as_is, '',
'... but a good token should set the new attribute');
$token->set_attr(bgcolor => 'white');
is($token->as_is, '',
'... or overwrite an existing one');
is_deeply($token->get_attrseq, [qw{alink bgcolor foo}],
'... and the attribute sequence should be updated');
my $attr = {
alink => "#0000ff",
bgcolor => "white",
foo => "bar"
};
is_deeply($token->get_attr, $attr,
'... as should the attributes themselves');
can_ok($token, 'delete_attr');
$token->delete_attr('asdf');
is($token->as_is, '',
'... and deleting a non-existent attribute should be a no-op');
$token->delete_attr('foo');
is($token->as_is, '',
'... and deleting an existing one should succeed');
$token->set_attr('foo', 'bar');
$token->delete_attr('FOO');
is($token->as_is, '',
'... and deleting should be case-insensitive');
do { $token = $p->get_token } until $token->is_start_tag('h1');
my $regex = qr/^h\d$/;
ok($token->is_tag($regex), 'Calling is_tag() with a regex should succeed');
ok(!$token->is_tag(qr/x/), '... and not return false positives');
ok($token->is_start_tag($regex), 'Calling is_start_tag() with a regex should succeed');
ok(!$token->is_start_tag(qr/x/), '... and not return false positives');
do { $token = $p->get_token } until $token->is_start_tag('hr');
$token->set_attr('class','fribble');
is($token->as_is, '
',
'Setting attributes on self-closing tags should succeed');
$token->delete_attr('class');
is($token->as_is, '
',
'... as should deleting them');
do { $token = $p->get_token } until $token->is_start_tag('hr');
$token->set_attr('class','fribble');
is($token->as_is, '
',
'Setting attributes on self-closing tags should succeed');
$token->delete_attr('class');
is($token->as_is, '
',
'... as should deleting them');
can_ok( $token, 'rewrite_tag');
my ($html,$fixed_html) = fetch_html();
my $parser = $CLASS->new(\$html);
my $new_html = '';
while (my $token = $parser->get_token) {
$token->rewrite_tag;
$new_html .= $token->as_is;
}
is($new_html, $fixed_html, '... and it should correctly rewrite all tags');
$html = '';
$parser = HTML::TokeParser::Simple->new(\$html);
my $span = $parser->get_tag('span');
is $span->as_is, $html, 'We should be able to fetch tags with escaped attributes';
ok $span->rewrite_tag, '... and rewriting said tags should succeed';
is $span->as_is, $html, '... and the attributes should be properly escaped';
sub fetch_html {
my $html = <<' END_HTML';
This is a title
";
?>
Do not edit this HTML lest the tests fail!!!
END_HTML
my $fixed_html = <<' END_HTML';
This is a title
";
?>
Do not edit this HTML lest the tests fail!!!
END_HTML
return $html,$fixed_html;
}
__DATA__
This is a title
";
?>
Do not edit this HTML lest the tests fail!!!