package Test::HTML::Tidy5;
use 5.010001;
use warnings;
use strict;
use Test::Builder;
use Exporter;
use HTML::Tidy5;
use parent 'Exporter';
our @EXPORT_OK = qw(
html_tidy_ok
html_fragment_tidy_ok
);
our @EXPORT = @EXPORT_OK;
=head1 NAME
Test::HTML::Tidy5 - Test::More-style wrapper around HTML::Tidy5
=head1 VERSION
Version 1.06
=cut
our $VERSION = '1.06';
my $TB = Test::Builder->new;
=head1 SYNOPSIS
use Test::HTML::Tidy5 tests => 4;
my $table = build_display_table();
html_tidy_ok( $table, 'Built display table properly' );
=head1 DESCRIPTION
This module provides a few convenience methods for testing exception
based code. It is built with L and plays happily with
L and friends.
If you are not already familiar with L now would be the time
to go take a look.
=head1 EXPORT
C
=cut
sub import {
my $self = shift;
my $pack = caller;
$TB->exported_to($pack);
$TB->plan(@_);
$self->export_to_level(1, $self, @EXPORT);
return;
}
=head2 html_tidy_ok( [$tidy, ] $html, $name )
Checks to see if C<$html> is a valid HTML document.
If you pass an HTML::Tidy5 object, C will use that for its
settings.
my $tidy = HTML::Tidy5->new( {config_file => 'path/to/config'} );
$tidy->ignore( type => TIDY_WARNING, type => TIDY_INFO );
html_tidy_ok( $tidy, $content, "Web page is OK, ignoring warnings and info' );
Otherwise, it will use the default rules.
html_tidy_ok( $content, "Web page passes ALL tests" );
=cut
sub html_tidy_ok {
my $tidy = (ref($_[0]) eq 'HTML::Tidy5') ? shift : HTML::Tidy5->new;
my $html = shift;
my $name = shift;
my $ok = defined $html;
if ( !$ok ) {
$TB->ok( 0, $name );
$TB->diag( 'Error: html_tidy_ok() got undef' );
}
else {
$ok = _parse_and_complain( $tidy, $html, $name, 0 );
}
return $ok;
}
=head2 html_fragment_tidy_ok( [$tidy, ] $html, $name )
Works the same as C, but first wraps it up an HTML document.
This is useful for when want to validate self-contained snippets of HTML,
such as from templates or an HTML feed from a third party, and check
that it is valid.
=cut
sub html_fragment_tidy_ok {
my $tidy = (ref($_[0]) eq 'HTML::Tidy5') ? shift : HTML::Tidy5->new;
my $html = shift;
my $name = shift;
my $ok = defined $html;
if ( !$ok ) {
$TB->ok( 0, $name );
$TB->diag( 'Error: html_fragment_tidy_ok() got undef' );
}
else {
$html = <<"HTML";
$html
HTML
$ok = _parse_and_complain( $tidy, $html, $name, 6 );
}
return $ok;
}
sub _parse_and_complain {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $tidy = shift;
my $html = shift;
my $name = shift;
my $offset = shift;
$tidy->clear_messages();
$tidy->parse( undef, $html );
my @messages = $tidy->messages;
my $nmessages = @messages;
my $ok = !$nmessages;
$TB->ok( $ok, $name );
if ( !$ok ) {
if ( $offset ) {
$_->{_line} -= $offset for @messages;
}
my $msg = 'Errors:';
$msg .= " $name" if $name;
$TB->diag( $msg );
$TB->diag( $_->as_string ) for @messages;
my $s = $nmessages == 1 ? '' : 's';
$TB->diag( "$nmessages message$s on the page" );
}
return $ok;
}
=head1 BUGS
All bugs and requests are now being handled through GitHub.
https://github.com/petdance/html-lint/issues
DO NOT send bug reports to http://rt.cpan.org/.
=head1 COPYRIGHT & LICENSE
Copyright 2005-2018 Andy Lester.
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License v2.0.
http://www.opensource.org/licenses/Artistic-2.0
Please note that these modules are not products of or supported by the
employers of the various contributors to the code.
=head1 AUTHOR
Andy Lester, C
=cut
1;