File Coverage

blib/lib/Test/HTML/T5.pm
Criterion Covered Total %
statement 66 66 100.0
branch 14 16 87.5
condition n/a
subroutine 11 11 100.0
pod 2 2 100.0
total 93 95 97.8


line stmt bran cond sub pod time code
1             package Test::HTML::T5;
2              
3 3     3   183013 use 5.010001;
  3         19  
4 3     3   15 use warnings;
  3         3  
  3         66  
5 3     3   12 use strict;
  3         3  
  3         54  
6              
7 3     3   13 use Test::Builder;
  3         4  
  3         91  
8 3     3   16 use Exporter;
  3         3  
  3         90  
9              
10 3     3   754 use HTML::T5 ();
  3         8  
  3         123  
11              
12 3     3   1136 use parent 'Exporter';
  3         755  
  3         17  
13              
14             our @EXPORT_OK = qw(
15             html_tidy_ok
16             html_fragment_tidy_ok
17             );
18              
19             our @EXPORT = @EXPORT_OK;
20              
21             =head1 NAME
22              
23             Test::HTML::T5 - Test::More-style wrapper around HTML::T5
24              
25             =head1 VERSION
26              
27             Version 0.012
28              
29             =cut
30              
31             our $VERSION = '0.012';
32              
33             my $TB = Test::Builder->new;
34              
35             =head1 SYNOPSIS
36              
37             use Test::HTML::T5 tests => 4;
38              
39             my $table = build_display_table();
40             html_tidy_ok( $table, 'Built display table properly' );
41              
42             =head1 DESCRIPTION
43              
44             This module provides a few convenience methods for testing exception
45             based code. It is built with L and plays happily with
46             L and friends.
47              
48             If you are not already familiar with L now would be the time
49             to go take a look.
50              
51             =head1 EXPORT
52              
53             C
54              
55             =cut
56              
57             sub import
58             {
59 3     3   17 my $self = shift;
60 3         7 my $pack = caller;
61              
62 3         10 $TB->exported_to($pack);
63 3         26 $TB->plan(@_);
64              
65 3         252 $self->export_to_level( 1, $self, @EXPORT );
66              
67 3         4571 return;
68             }
69              
70             =head2 html_tidy_ok( [$tidy, ] $html, $name )
71              
72             Checks to see if C<$html> is a valid HTML document.
73              
74             If you pass an HTML::T5 object, C will use that for its
75             settings.
76              
77             my $tidy = HTML::T5->new( {config_file => 'path/to/config'} );
78             $tidy->ignore( type => TIDY_WARNING, type => TIDY_INFO );
79             html_tidy_ok( $tidy, $content, "Web page is OK, ignoring warnings and info' );
80              
81             Otherwise, it will use the default rules.
82              
83             html_tidy_ok( $content, "Web page passes ALL tests" );
84              
85             =cut
86              
87             sub html_tidy_ok
88             {
89 10 100   10 1 36971 my $tidy = ( ref( $_[0] ) eq 'HTML::T5' ) ? shift : HTML::T5->new;
90 10         15 my $html = shift;
91 10         12 my $name = shift;
92              
93 10         14 my $ok = defined $html;
94 10 100       18 if ( !$ok )
95             {
96 1         4 $TB->ok( 0, $name );
97 1         1106 $TB->diag('Error: html_tidy_ok() got undef');
98             }
99             else
100             {
101 9         19 $ok = _parse_and_complain( $tidy, $html, $name, 0 );
102             }
103              
104 10         505 return $ok;
105             }
106              
107             =head2 html_fragment_tidy_ok( [$tidy, ] $html, $name )
108              
109             Works the same as C, but first wraps it up an HTML document.
110             This is useful for when want to validate self-contained snippets of HTML,
111             such as from templates or an HTML feed from a third party, and check
112             that it is valid.
113              
114             =cut
115              
116             sub html_fragment_tidy_ok
117             {
118 3 50   3 1 12342 my $tidy = ( ref( $_[0] ) eq 'HTML::T5' ) ? shift : HTML::T5->new;
119 3         17 my $html = shift;
120 3         8 my $name = shift;
121              
122 3         3 my $ok = defined $html;
123 3 100       7 if ( !$ok )
124             {
125 1         4 $TB->ok( 0, $name );
126 1         1027 $TB->diag('Error: html_fragment_tidy_ok() got undef');
127             }
128             else
129             {
130 2         5 $html = <<"HTML";
131            
132            
133            
134            
135            
136            
137             $html
138            
139            
140             HTML
141              
142 2         4 $ok = _parse_and_complain( $tidy, $html, $name, 6 );
143             }
144              
145 3         430 return $ok;
146             }
147              
148             sub _parse_and_complain
149             {
150 11     11   16 local $Test::Builder::Level = $Test::Builder::Level + 1;
151              
152 11         13 my $tidy = shift;
153 11         14 my $html = shift;
154 11         12 my $name = shift;
155 11         14 my $offset = shift;
156              
157 11         24 $tidy->clear_messages();
158 11         28 $tidy->parse( undef, $html );
159              
160 11         23 my @messages = $tidy->messages;
161 11         19 my $nmessages = @messages;
162              
163 11         14 my $ok = !$nmessages;
164 11         31 $TB->ok( $ok, $name );
165 11 100       10799 if ( !$ok )
166             {
167 10 100       21 if ($offset)
168             {
169 2         6 $_->{_line} -= $offset for @messages;
170             }
171 10         18 my $msg = 'Errors:';
172 10 50       24 $msg .= " $name" if $name;
173 10         36 $TB->diag($msg);
174 10         4553 $TB->diag( $_->as_string ) for @messages;
175 10 100       4510 my $s = $nmessages == 1 ? '' : 's';
176 10         35 $TB->diag("$nmessages message$s on the page");
177             }
178              
179 11         4496 return $ok;
180             }
181              
182             =head1 BUGS
183              
184             All bugs and requests are now being handled through GitHub.
185              
186             https://github.com/petdance/html-lint/issues
187              
188             DO NOT send bug reports to http://rt.cpan.org/.
189              
190             =head1 COPYRIGHT & LICENSE
191              
192             Copyright 2005-2018 Andy Lester.
193              
194             This program is free software; you can redistribute it and/or modify
195             it under the terms of the Artistic License v2.0.
196              
197             http://www.opensource.org/licenses/Artistic-2.0
198              
199             Please note that these modules are not products of or supported by the
200             employers of the various contributors to the code.
201              
202             =head1 AUTHOR
203              
204             Andy Lester, C
205              
206             =cut
207              
208             1;