The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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, '<body alink="#0000ff" bgcolor="#ffffff" foo="bar">',
                                  '... but a good token should set the new attribute');
$token->set_attr(bgcolor => 'white');
is($token->as_is, '<body alink="#0000ff" bgcolor="white" foo="bar">',
                                  '... 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, '<body alink="#0000ff" bgcolor="white" foo="bar">',
                                  '... and deleting a non-existent attribute should be a no-op');
$token->delete_attr('foo');
is($token->as_is, '<body alink="#0000ff" bgcolor="white">',
                                  '... and deleting an existing one should succeed'); 
$token->set_attr('foo', 'bar');
$token->delete_attr('FOO');
is($token->as_is, '<body alink="#0000ff" bgcolor="white">',
                                  '... 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, '<hr class="fribble" />',
                                  'Setting attributes on self-closing tags should succeed');
$token->delete_attr('class');
is($token->as_is, '<hr />',
                                  '... as should deleting them');

do { $token = $p->get_token } until $token->is_start_tag('hr');
$token->set_attr('class','fribble');
is($token->as_is, '<hr class="fribble"/>',
                                  'Setting attributes on self-closing tags should succeed');
$token->delete_attr('class');
is($token->as_is, '<hr/>',
                                  '... 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 = '<span title="with &quot;kwotes&quot; inside">';
$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';
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
	<HEAD>
		<!-- This is a comment -->
		<title>This is a title</title>
		<?php 
			print "<!-- this is generated by php -->";
		?>
	</head>
	<body alink=#0000ff BGCOLOR=#ffffff>
		<h1>Do not edit this HTML lest the tests fail!!!</h1>
        <hr class="foo" />
        <hr class='bar'/>
	</body>
</html>
    END_HTML

    my $fixed_html = <<'    END_HTML';
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
	<head>
		<!-- This is a comment -->
		<title>This is a title</title>
		<?php 
			print "<!-- this is generated by php -->";
		?>
	</head>
	<body alink="#0000ff" bgcolor="#ffffff">
		<h1>Do not edit this HTML lest the tests fail!!!</h1>
        <hr class="foo" />
        <hr class="bar"/>
	</body>
</html>
    END_HTML
    return $html,$fixed_html;
}
__DATA__
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
	<head>
		<!-- This is a comment -->
		<title>This is a title</title>
		<?php 
			print "<!-- this is generated by php -->";
		?>
	</head>
	<body alink="#0000ff" BGCOLOR="#ffffff">
		<h1>Do not edit this HTML lest the tests fail!!!</h1>
    <hr class="foo" />
    <hr class="bar"/>
	</body>
</html>