HTML-Lint-2.32/ 0000755 0001750 0001750 00000000000 13313263532 011561 5 ustar andy andy HTML-Lint-2.32/README.md 0000644 0001750 0001750 00000001116 13220756434 013044 0 ustar andy andy # HTML::Lint
* Linux [](https://travis-ci.org/petdance/html-lint)
* [CPAN Testers](http://cpantesters.org/distro/H/html-lint.html)
HTML::Lint is a pure-Perl HTML parser and checker for syntactic legitmacy.
It supports only HTML 4.
The "weblint" program that comes with HTML::Lint lets you lint a webpage
or local files.
For those of you doing automated testing with Test::More and the rest
of the Perl testing framework, Test::HTML::Lint lets you automate HTML
checking.
Andy Lester
andy at petdance dot com
HTML-Lint-2.32/MANIFEST 0000644 0001750 0001750 00000002331 13313263532 012711 0 ustar andy andy Changes
MANIFEST
Makefile.PL
README.md
bin/weblint
lib/HTML/Lint.pm
lib/HTML/Lint/Error.pm
lib/HTML/Lint/HTML4.pm
lib/HTML/Lint/Parser.pm
lib/Test/HTML/Lint.pm
t/00-load.t
t/01-coverage.t
t/02-versions.t
t/10-test-html-lint.t
t/11-test-html-lint-overload.t
t/12-html_fragment_ok.t
t/20-error-types-export.t
t/20-error-types-skip.t
t/20-error-types.t
t/30-test-builder.t
t/40-where.t
t/50-multiple-files.t
t/60-add-tags.t
t/Util.pm
t/api-eof-not-called.t
t/api-parse-not-called.t
t/attr-invalid-entity.t
t/attr-repeated.t
t/attr-unclosed-entity.t
t/attr-unknown-entity.t
t/attr-unknown.t
t/attr-use-entity.t
t/config-unknown-directive.t
t/config-unknown-value.t
t/doc-tag-required.t
t/elem-empty-but-closed.t
t/elem-img-alt-missing.t
t/elem-img-sizes-missing.t
t/elem-input-alt-missing.t
t/elem-nonrepeatable.t
t/elem-unclosed.t
t/elem-unknown.t
t/elem-unopened.t
t/embed-extensions.t
t/nolint.t
t/parse_file.t
t/pod-coverage.t
t/pod.t
t/random-nobr.t
t/strong-id.t
t/text-invalid-entity.t
t/text-unclosed-entity.t
t/text-unknown-entity.t
t/text-use-entity.t
t/xhtml-html.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
HTML-Lint-2.32/Makefile.PL 0000644 0001750 0001750 00000005243 13220756434 013544 0 ustar andy andy use strict;
use warnings;
use ExtUtils::MakeMaker qw( WriteMakefile );
use 5.006001;
if ( not eval { require LWP::Simple; 1; } ) {
print <<'EOF';
NOTE: It seems that you don't have LWP::Simple installed.
The weblint program will not be able to retrieve web pages.
EOF
}
my %parms = (
NAME => 'HTML::Lint',
DISTNAME => 'HTML-Lint',
VERSION_FROM => 'lib/HTML/Lint.pm',
ABSTRACT_FROM => 'lib/HTML/Lint.pm',
PMLIBDIRS => [qw(lib/)],
AUTHOR => 'Andy Lester ',
MIN_PERL_VERSION=> 5.006,
PREREQ_PM => {
'Exporter' => 0,
'Test::More' => 0,
'Test::Builder' => 0,
'Test::Builder::Tester' => 0,
'File::Find' => 0,
'HTML::Entities' => 0,
'HTML::Parser' => '3.47',
'HTML::Tagset' => '3.03',
},
EXE_FILES => [qw(bin/weblint)],
dist => {
COMPRESS => 'gzip -9f',
SUFFIX => 'gz',
},
clean => { FILES => 'HTML-Lint-*' },
);
if ( $ExtUtils::MakeMaker::VERSION =~ /^\d[.]\d\d$/ and $ExtUtils::MakeMaker::VERSION > 6.30 ) {
$parms{LICENSE} = 'artistic_2';
}
if ( $ExtUtils::MakeMaker::VERSION ge '6.46' ) {
$parms{META_ADD} = {
resources => {
homepage => 'http://search.cpan.org/dist/html-lint',
bugtracker => 'https://github.com/petdance/html-lint/issues',
license => 'http://www.opensource.org/licenses/artistic-license-2.0.php',
repository => 'https://github.com/petdance/html-lint',
},
};
}
WriteMakefile( %parms );
sub MY::postamble { ## no critic ( Subroutines::ProhibitQualifiedSubDeclarations )
my $postamble = <<'MAKE_FRAG';
.PHONY: tags critic
tags:
ctags -f tags --recurse --totals \
--exclude=blib \
--exclude=.svn \
--exclude='*~' \
--languages=Perl --langmap=Perl:+.t \
critic:
perlcritic -1 -q -profile perlcriticrc $(ack -f --perl)
PROF_ARGS = -Mblib blib/script/weblint index.html
timed: all
$(PERL) $(PROF_ARGS) >> /dev/null 2>&1
dprof: all
$(PERL) -d:DProf $(PROF_ARGS) >> /dev/null 2>&1
dprofpp -R
dproflb: all
$(PERL) -d:DProfLB $(PROF_ARGS) >> /dev/null 2>&1
dprofpp -R
fastprof: all
$(PERL) -d:FastProf $(PROF_ARGS) >> /dev/null 2>&1
fprofpp
profile: all
$(PERL) -d:Profile $(PROF_ARGS) >> /dev/null 2>&1
less prof.out
profiler: all
$(PERL) -MDevel::Profiler $(PROF_ARGS) >> /dev/null 2>&1
dprofpp -R
smallprof: all
$(PERL) -d:SmallProf $(PROF_ARGS) >> /dev/null 2>&1
sort -k 2nr,2 smallprof.out | less
nytprof: all
$(PERL) -d:NYTProf $(PROF_ARGS) >> /dev/null 2>&1
nytprofhtml
MAKE_FRAG
return $postamble;
}
HTML-Lint-2.32/META.json 0000664 0001750 0001750 00000003002 13313263532 013177 0 ustar andy andy {
"abstract" : "check for HTML errors in a string or file",
"author" : [
"Andy Lester "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.143240",
"license" : [
"artistic_2"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "HTML-Lint",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Exporter" : "0",
"File::Find" : "0",
"HTML::Entities" : "0",
"HTML::Parser" : "3.47",
"HTML::Tagset" : "3.03",
"Test::Builder" : "0",
"Test::Builder::Tester" : "0",
"Test::More" : "0",
"perl" : "5.006"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/petdance/html-lint/issues"
},
"homepage" : "http://search.cpan.org/dist/html-lint",
"license" : [
"http://www.opensource.org/licenses/artistic-license-2.0.php"
],
"repository" : {
"url" : "https://github.com/petdance/html-lint"
}
},
"version" : "2.32"
}
HTML-Lint-2.32/bin/ 0000755 0001750 0001750 00000000000 13313263531 012330 5 ustar andy andy HTML-Lint-2.32/bin/weblint 0000755 0001750 0001750 00000004747 13313263060 013733 0 ustar andy andy #!/usr/bin/perl -w
use warnings;
use strict;
use Getopt::Long;
use HTML::Lint;
use HTML::Lint::Error;
use HTML::Lint::HTML4;
my $help;
my $context;
my $structure = 1;
my $helper = 1;
my $fluff = 1;
GetOptions(
'help' => \$help,
'context:i' => \$context,
'only' => sub { $structure = $helper = $fluff = 0; },
'structure!' => \$structure,
'helper!' => \$helper,
'fluff!' => \$fluff,
) or $help = 1;
if ( !@ARGV || $help ) {
print "weblint v$HTML::Lint::VERSION\n";
print ;
exit 1;
}
my @types;
push( @types, HTML::Lint::Error::STRUCTURE ) if $structure;
push( @types, HTML::Lint::Error::HELPER ) if $helper;
push( @types, HTML::Lint::Error::FLUFF ) if $fluff;
my $lint = HTML::Lint->new;
$lint->only_types( @types ) if @types;
for my $url ( @ARGV ) {
my @lines;
$lint->newfile( $url );
if ( $url =~ /^https?:/ ) {
if ( !eval { require LWP::Simple; 1; } ) {
warn q{Can't retrieve URLs without LWP::Simple installed};
next;
}
my $content = LWP::Simple::get( $url );
if ( $content ) {
@lines = split( /\n/, $content );
$_ = "$_\n" for @lines;
}
else {
warn "Unable to fetch $url\n";
next;
}
}
elsif ( $url eq '-' ) {
@lines = ;
}
else {
open( my $fh, '<', $url ) or die "Can't open $url: $!";
@lines = <$fh>;
close $fh or die $!;
}
$lint->parse( $_ ) for @lines;
$lint->eof();
for my $error ( $lint->errors() ) {
print $error->as_string(), "\n";
if ( defined $context ) {
$context += 0;
my $lineno = $error->line - 1;
my $start = $lineno-$context;
$start = 0 if $start < 0;
my $end = $lineno+$context;
$end = $#lines if $end > $#lines;
print " $_\n" for @lines[$start..$end];
print "\n";
}
}
$lint->clear_errors();
} # for files
__END__
Usage: weblint [filename or url]... (filename - reads STDIN)
--help This message
--context[=n] Show the offending line (and n surrounding lines)
Error types: (default: all on)
--[no]structure Structural issues, like unclosed tag pairs
--[no]helper Helper issues, like missing HEIGHT & WIDTH
--[no]fluff Fluff that can be removed, like bad tag attributes
--only Turns off all other error types, as in --only --fluff
HTML-Lint-2.32/t/ 0000755 0001750 0001750 00000000000 13313263531 012023 5 ustar andy andy HTML-Lint-2.32/t/config-unknown-directive.t 0000644 0001750 0001750 00000000750 13220756434 017136 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
# [ 'config-unknown-directive' => q{Set #1 (6:5) Unknown directive "bongo"} ],
[ 'config-unknown-directive' => qr/Unknown directive "bongo"$/ ],
], [] );
__DATA__
Test stuff
HTML-Lint-2.32/t/text-unclosed-entity.t 0000644 0001750 0001750 00000002243 13220756434 016327 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'text-unclosed-entity' => qr/Entity ö is missing its closing semicolon/ ],
[ 'text-unclosed-entity' => qr/Entity ? is missing its closing semicolon/ ],
[ 'text-unknown-entity' => qr/Entity &middle is unknown/ ],
], [] );
__DATA__
Ace of ♠: A tribute to Motörhead.
Motö rhead rulez!
⊃ ² But can we find an unclosed entity at the end of the line ?
What about unclosed unknown entities in the &middle of the line?
Here's an awesome link to "You Better Swim" from the SpongeBob movie.
HTML-Lint-2.32/t/00-load.t 0000644 0001750 0001750 00000000305 13220756434 013350 0 ustar andy andy #!perl -Tw
use strict;
use warnings;
use Test::More tests => 1;
use HTML::Lint;
use Test::HTML::Lint;
pass( 'Loaded modules' );
diag( "Testing HTML::Lint $HTML::Lint::VERSION, Perl $], $^X" );
HTML-Lint-2.32/t/elem-unclosed.t 0000644 0001750 0001750 00000000710 13220756434 014750 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-unclosed' => qr/\Q at (6:12) is never closed/i ],
[ 'elem-unclosed' => qr/\Q at (7:12) is never closed/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
This is another paragraph
HTML-Lint-2.32/t/attr-unknown.t 0000644 0001750 0001750 00000000765 13220756434 014675 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'attr-unknown' => qr/Unknown attribute "FOOD" for tag
/i ],
[ 'attr-unknown' => qr/Unknown attribute "Yummy" for tag /i ],
], [] );
__DATA__
Test stuff
This is my paragraph about burritos
This is my paragraph about refried beans
HTML-Lint-2.32/t/12-html_fragment_ok.t 0000644 0001750 0001750 00000004352 13220756434 015762 0 ustar andy andy #!perl
use warnings;
use strict;
use Test::More tests => 4;
use Test::Builder::Tester;
use Test::HTML::Lint;
my $not_so_good_html = <<'HTML';
This is a valid fragment (with some errors), but an incomplete document.
HTML
HTML_OK: {
test_out( 'not ok 1 - Called html_ok' );
test_fail( +8 );
test_diag( 'Errors: Called html_ok' );
test_diag( ' (3:5) does not have ALT text defined' );
test_diag( ' (4:5) does not have non-blank ALT text defined' );
test_diag( ' (5:1) tag is required' );
test_diag( ' (5:1) tag is required' );
test_diag( ' (5:1) tag is required' );
test_diag( ' (5:1) tag is required' );
html_ok( $not_so_good_html, 'Called html_ok' );
test_test( 'html_ok works on wonky fragment' );
}
HTML_FRAGMENT_OK: {
test_out( 'not ok 1 - Called html_fragment_ok' );
test_fail( +4 );
test_diag( 'Errors: Called html_fragment_ok' );
test_diag( ' (3:5) does not have ALT text defined' );
test_diag( ' (4:5) does not have non-blank ALT text defined' );
html_fragment_ok( $not_so_good_html, 'Called html_fragment_ok' );
test_test( 'html_fragment_ok works on wonky fragment' );
}
# HTML that is a valid fragment, but not a valid document.
my $ok_fragment = <<'HTML';
This is a valid fragment (with some errors), but an incomplete document.
HTML
HTML_OK: {
test_out( 'not ok 1 - Called html_ok' );
test_fail( +6 );
test_diag( 'Errors: Called html_ok' );
test_diag( ' (5:1) tag is required' );
test_diag( ' (5:1) tag is required' );
test_diag( ' (5:1) tag is required' );
test_diag( ' (5:1) tag is required' );
html_ok( $ok_fragment, 'Called html_ok' );
test_test( 'html_ok gets back doc-level errors on fragment' );
}
HTML_FRAGMENT_OK: {
test_out( 'ok 1 - Called html_fragment_ok' );
html_fragment_ok( $ok_fragment, 'Called html_fragment_ok' );
test_test( 'html_fragment_ok passes on fragment' );
}
HTML-Lint-2.32/t/attr-unknown-entity.t 0000644 0001750 0001750 00000000460 13220756434 016177 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'attr-unknown-entity' => qr/Entity &numsefisk; is unknown/ ],
], [] );
__DATA__
Test stuff
HTML-Lint-2.32/t/elem-img-alt-missing.t 0000644 0001750 0001750 00000000637 13220756434 016145 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-img-alt-missing' => qr/ does not have ALT text defined/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/10-test-html-lint.t 0000644 0001750 0001750 00000000455 13220756434 015325 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 2;
use Test::HTML::Lint;
my $chunk = 'A fine chunk of code';
TODO: { # undef should fail
local $TODO = 'This test should NOT succeed';
html_ok( undef );
}
html_ok( $chunk );
HTML-Lint-2.32/t/xhtml-html.t 0000644 0001750 0001750 00000002261 13220756434 014315 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
], [] );
__DATA__
Test stuff
This test brought to you by Mötley Crüe.
Blah blah blah
Now listen up
She's razor sharp
If she don't get her way
She'll slice you apart
Now she's cool cool black
Moves like a cat
If you don't get her game
You might not make it back
(Pre chorus)
She's got the look's that kill
That kill
She's got the look's that kill
That kill
(Chorus)
She's got the looks that kill
Now she's bullet proof
Keeps her motor clean
And believe me you
She's a number thirteen
The church strikes midnight
She's lookin' louder and louder
She's gonna turn on your juice, boy
So she turns on the power
(Pre-chorus)
She's got the looks that kill
(Chorus)(Solo)(Verse)(Pre-chorus)(Chorus)
HTML-Lint-2.32/t/config-unknown-value.t 0000644 0001750 0001750 00000001255 13220756434 016275 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'config-unknown-value' => qr/Unknown value "14" for elem-img-sizes-missing directive$/ ],
], [] );
__DATA__
Test stuff
HTML-Lint-2.32/t/parse_file.t 0000644 0001750 0001750 00000001333 13220756434 014327 0 ustar andy andy #!perl -T
use warnings;
use strict;
use Test::More tests => 1;
use HTML::Lint;
use File::Temp qw( tempfile );
my ($o, $OUTPUT_FN) = tempfile( SUFFIX => '.xhtml', UNLINK => 1);
print {$o} <<'EOF';
Foo
Hello
File
EOF
close($o) or die $!;
my $lint = HTML::Lint->new;
$lint->parse_file($OUTPUT_FN);
is_deeply( [map { $_->as_string() } $lint->errors()], [], 'HTML is valid for output file.' );
HTML-Lint-2.32/t/elem-input-alt-missing.t 0000644 0001750 0001750 00000002167 13220756434 016530 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-input-alt-missing' => qr/ does not have non-blank ALT text defined/i ],
[ 'elem-input-alt-missing' => qr/ does not have non-blank ALT text defined/i ],
[ 'elem-input-alt-missing' => qr/ does not have non-blank ALT text defined/i ],
[ 'elem-input-alt-missing' => qr/ does not have non-blank ALT text defined/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/elem-unknown.t 0000644 0001750 0001750 00000000773 13220756434 014644 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-unknown' => qr/unknown element /i ],
[ 'elem-unclosed' => qr/ at \(\d+:\d+\) is never closed/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/50-multiple-files.t 0000644 0001750 0001750 00000002573 13220756434 015402 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
my @files = _get_paragraphed_files();
checkit( [
[ 'elem-unopened' => qr/<\/p> with no opening
/i ],
[ 'elem-unclosed' => qr/\Q at (6:12) is never closed/i ],
[ 'elem-unclosed' => qr/\Q at (7:12) is never closed/i ],
[ 'elem-unopened' => qr/<\/b> with no opening /i ],
], @files );
# Read in a set of sets of lines, where each "file" is separated by a
# blank line in
sub _get_paragraphed_files {
local $/ = '';
my @sets;
while ( my $paragraph = ) {
my @lines = split /\n/, $paragraph;
@lines = map { "$_\n" } @lines;
push( @sets, [@lines] );
}
return @sets;
}
__DATA__
Test stuff
This is my paragraph
Test stuff
This is my paragraph
This is another paragraph
Test stuff
Gratuitous unnecessary closing tag that does NOT match to the opening [B] above.
This is my paragraph
HTML-Lint-2.32/t/elem-img-sizes-missing.t 0000644 0001750 0001750 00000001170 13220756434 016513 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-img-sizes-missing' => qr/\Q tag has no HEIGHT and WIDTH attributes/i ],
[ 'elem-img-sizes-missing' => qr/\Q tag has no HEIGHT and WIDTH attributes/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/attr-repeated.t 0000644 0001750 0001750 00000000516 13220756434 014761 0 ustar andy andy #!perl
use strict;
use warnings;
use lib 't/';
use Util;
checkit( [
[ 'attr-repeated' => qr/ALIGN attribute in
is repeated/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/api-eof-not-called.t 0000644 0001750 0001750 00000000727 13027375770 015571 0 ustar andy andy #!perl
use warnings;
use strict;
use Test::More tests => 3;
use HTML::Lint;
use HTML::Lint::HTML4;
my $lint = HTML::Lint->new;
isa_ok( $lint, 'HTML::Lint', 'Created lint object' );
$lint->newfile( '' );
$lint->parse( '
Blah blah
' );
my @errors = $lint->errors();
cmp_ok( scalar @errors, '>', 0, 'Should get back at least one error' );
my $error = $errors[-1];
is( $error->errcode, 'api-eof-not-called', 'The last error in the list is the API error' );
HTML-Lint-2.32/t/40-where.t 0000644 0001750 0001750 00000002254 13220756434 013554 0 ustar andy andy #!perl
use strict;
use warnings;
use lib 't/';
use Util;
my $html = '';
checkit( [
[ 'elem-unopened' => 'Set #1 (1:1) with no opening ' ],
[ 'doc-tag-required' => 'Set #1 (1:1) tag is required' ],
[ 'doc-tag-required' => 'Set #1 (1:1) tag is required' ],
[ 'doc-tag-required' => 'Set #1 (1:1) tag is required' ],
[ 'doc-tag-required' => 'Set #1 (1:1) tag is required' ],
], [$html] );
__END__
This doesn't test the error finding as much as the where() method.
It fixes the following bug:
Date: Mon, 22 Dec 2003 22:07:54 -0800
From: Adam Monsen
To: Andy Lester
Subject: HTML::Lint::Error bug
The following demonstrates a bug in HTML::Lint that is seen when an
offending tag is flush left ...
use HTML::Lint;
my $lint = HTML::Lint->new();
$lint->parse('');
warn $_->as_string."\n" for $lint->errors;
The warning I'm getting looks like this:
Argument "" isn't numeric in addition (+) at /usr/lib/perl5/site_perl/5.8.1/HTML/Lint/Error.pm line 176.
If I change the parse() call as follows (by adding a leading space):
$lint->parse(' ');
the warning disappears.
HTML-Lint-2.32/t/20-error-types-skip.t 0000644 0001750 0001750 00000003043 13220756434 015674 0 ustar andy andy #!perl -Tw
use strict;
use warnings;
use Test::More tests => 8;
use HTML::Lint;
use HTML::Lint::Error ':types';
my $text = do { local $/ = undef; };
FUNC_METHOD: {
my $lint = HTML::Lint->new();
isa_ok( $lint, 'HTML::Lint' );
$lint->parse( $text );
$lint->eof;
is( scalar $lint->errors, 1, 'One error with a clean lint' );
$lint->newfile();
$lint->clear_errors();
$lint->only_types( HELPER, FLUFF );
$lint->parse( $text );
$lint->eof;
is( scalar $lint->errors, 0, 'No errors if helper & fluff' );
$lint->newfile();
$lint->clear_errors();
$lint->only_types( STRUCTURE );
$lint->parse( $text );
$lint->eof;
my @errors = $lint->errors;
if ( !is( scalar @errors, 1, 'One error if we specify STRUCTURE if we turn it off' ) ) {
diag( $_->as_string ) for @errors;
}
}
CONSTRUCTOR_METHOD_SCALAR: {
my $lint = HTML::Lint->new( only_types => STRUCTURE );
isa_ok( $lint, 'HTML::Lint' );
$lint->parse( $text );
my @errors = $lint->errors;
if ( !is( scalar @errors, 1, 'One error if we specify STRUCTURE if we turn it off' ) ) {
diag( $_->as_string ) for @errors;
}
}
CONSTRUCTOR_METHOD_ARRAYREF: {
my $lint = HTML::Lint->new( only_types => [HELPER, FLUFF] );
isa_ok( $lint, 'HTML::Lint' );
$lint->parse( $text );
is( scalar $lint->errors, 0, 'No errors if helper & fluff' );
}
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/text-invalid-entity.t 0000644 0001750 0001750 00000003021 13224570052 016126 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
# We used to have text-invalid-entity if the entities had an invalid value, but we no longer do.
checkit( [
[ 'text-unknown-entity' => qr/Entity &metalhorns; is unknown/ ],
[ 'text-unknown-entity' => qr/Entity &xdeadbeef; is unknown/ ],
], [] );
__DATA__
Ace of ♠: A tribute to Motörhead. ® &metalhorns;
Thanks for visiting Ace of ♠
Ace of ♠ is your single source for everything related to Motörhead.
Here's an icon of my girlfriend Jenny:
And here's an icon of a deceased cow:
Another deceased cow: &xdeadbeef;
Here's an awesome link to "You Better Swim" from the SpongeBob movie.
HTML-Lint-2.32/t/random-nobr.t 0000644 0001750 0001750 00000000660 13220756434 014436 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-unknown' => qr/unknown element /i ],
[ 'elem-unclosed' => qr/ at \(\d+:\d+\) is never closed/i ],
], [] );
__DATA__
Test stuffNOBR is fine with me!But Donky is not
HTML-Lint-2.32/t/attr-use-entity.t 0000644 0001750 0001750 00000001153 13220756434 015274 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'attr-use-entity' => qr/Character "\\xF1" should be written as ñ/ ],
[ 'attr-use-entity' => qr/Character "&" should be written as &/ ],
[ 'attr-use-entity' => qr/Character "&" should be written as &/ ],
], [] );
__DATA__
Test stuff
HTML-Lint-2.32/t/elem-unopened.t 0000644 0001750 0001750 00000000506 13220756434 014754 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-unopened' => qr/<\/p> with no opening
/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/text-use-entity.t 0000644 0001750 0001750 00000003024 13220756434 015305 0 ustar andy andy #!perl
use utf8;
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'text-use-entity' => qr/Character "\\x0B" should be written as / ],
[ 'text-use-entity' => qr/Character "\\x38C" should be written as Ό/ ],
[ 'text-use-entity' => qr/Character "\\xF1" should be written as ñ/ ],
[ 'text-use-entity' => qr/Character "&" should be written as &/ ],
[ 'text-unclosed-entity' => qr/Entity ö is missing its closing semicolon/ ],
[ 'text-use-entity' => qr/Character "&" should be written as &/ ],
], [] );
__DATA__
Test stuff
Here's a non-entityable char [].
And here's a non-entityable char over 255 [Ό].
We'll get to it mañana, which should really have an ñ.
Who wants a peanut butter & jelly? Motö rhead does! They love rock &
roll!
Here's an awesome link to "You Better Swim" from the SpongeBob movie.
HTML-Lint-2.32/t/20-error-types-export.t 0000644 0001750 0001750 00000000620 13220756434 016245 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 4;
use HTML::Lint::Error ':types';
my $err = HTML::Lint::Error->new( undef, undef, undef, 'elem-empty-but-closed' );
ok( $err->is_type( STRUCTURE ) );
ok( !$err->is_type( FLUFF, HELPER ) );
$err = HTML::Lint::Error->new( undef, undef, undef, 'attr-unknown' );
ok( $err->is_type( FLUFF ) );
ok( !$err->is_type( STRUCTURE, HELPER ) );
HTML-Lint-2.32/t/strong-id.t 0000644 0001750 0001750 00000001653 13220756434 014131 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'attr-unknown' => qr/Unknown attribute "bongo" for tag / ],
], [] );
=pod
HTML::Lint 2.02 and weblint, Red Hat EL 3
This should result in no warnings:
echo 'qwerasdf' | weblint -
- (1:45) Unknown attribute "id" for tag
but it gives:
- (1:45) Unknown attribute "id" for tag
id is a core attribute in HTML4/XHTML1: http://www.w3.org/TR/html4/html40.txt
=cut
__DATA__
Test stuff
HTML-Lint-2.32/t/attr-unclosed-entity.t 0000644 0001750 0001750 00000001105 13220756434 016311 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'attr-unclosed-entity' => qr/Entity ? is missing its closing semicolon/ ],
[ 'attr-unclosed-entity' => qr/Entity ö is missing its closing semicolon/ ],
], [] );
__DATA__
Test stuffMotörheadMotörhead
HTML-Lint-2.32/t/20-error-types.t 0000644 0001750 0001750 00000000771 13220756434 014735 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 4;
use HTML::Lint::Error;
my $err = HTML::Lint::Error->new( undef, undef, undef, 'elem-empty-but-closed' );
ok( $err->is_type( HTML::Lint::Error::STRUCTURE ) );
ok( !$err->is_type( HTML::Lint::Error::FLUFF, HTML::Lint::Error::HELPER ) );
$err = HTML::Lint::Error->new( undef, undef, undef, 'attr-unknown' );
ok( $err->is_type( HTML::Lint::Error::FLUFF ) );
ok( !$err->is_type( HTML::Lint::Error::STRUCTURE, HTML::Lint::Error::HELPER ) );
HTML-Lint-2.32/t/pod-coverage.t 0000644 0001750 0001750 00000000417 13220756434 014573 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More;
if ( !eval 'use Test::Pod::Coverage 1.04; 1;' ) { ## no critic ( BuiltinFunctions::ProhibitStringyEval )
plan skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage';
}
all_pod_coverage_ok();
HTML-Lint-2.32/t/60-add-tags.t 0000644 0001750 0001750 00000001435 13220756434 014130 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
use HTML::Lint::HTML4;
# This test is the same as t/attr-unknown.t, but with tag table modification.
HTML::Lint::HTML4::add_attribute( 'p', 'food' );
HTML::Lint::HTML4::add_attribute( 'body', 'cuisine' );
HTML::Lint::HTML4::add_tag( 'meal' );
HTML::Lint::HTML4::add_attribute( 'meal', 'type' );
checkit( [
[ 'attr-unknown' => qr/Unknown attribute "Yummy" for tag /i ],
], [] );
__DATA__
Test stuff
This is my paragraph about burritos
This is my paragraph about refried beansSteak burrito
HTML-Lint-2.32/t/elem-empty-but-closed.t 0000644 0001750 0001750 00000000521 13220756434 016331 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-empty-but-closed' => qr/ is not a container -- <\/hr> is not allowed/ ],
], [] );
__DATA__
Test stuffThis is a bad paragraph
HTML-Lint-2.32/t/doc-tag-required.t 0000644 0001750 0001750 00000000470 13220756434 015353 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'doc-tag-required' => qr/ tag is required/ ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.32/t/02-versions.t 0000644 0001750 0001750 00000000530 13220756434 014303 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 2;
use HTML::Lint::Parser;
use HTML::Lint;
use Test::HTML::Lint;
is( $HTML::Lint::VERSION, $Test::HTML::Lint::VERSION, 'HTML::Lint and Test::HTML::Lint versions match' );
is( $HTML::Lint::VERSION, $HTML::Lint::Parser::VERSION, 'HTML::Lint and Test::HTML::Lint versions match' );
HTML-Lint-2.32/t/nolint.t 0000644 0001750 0001750 00000002460 13220756434 013523 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-img-sizes-missing' => qr/\Q tag has no HEIGHT and WIDTH attributes/i ],
[ 'elem-img-alt-missing' => qr/\Q does not have ALT text defined/i ],
[ 'elem-img-alt-missing' => qr/\Q does not have ALT text defined/i ],
# gamma.jpg will not error at all
[ 'elem-img-alt-missing' => qr/\Q does not have ALT text defined/i ],
[ 'elem-img-sizes-missing' => qr/\Q tag has no HEIGHT and WIDTH attributes/i ],
[ 'elem-img-alt-missing' => qr/\Q does not have ALT text defined/i ],
[ 'elem-unclosed' => 'Set #1 (20:5) at (13:9) is never closed' ],
], [] );
__DATA__
Test stuff
HTML-Lint-2.32/t/01-coverage.t 0000644 0001750 0001750 00000000617 13220756434 014233 0 ustar andy andy #!perl -Tw
# This test verifies that there is a t/*.t file for every possible Lint error.
use strict;
use warnings;
use Test::More 'no_plan';
use HTML::Lint::Error;
my @errors = keys %HTML::Lint::Error::errors;
isnt( scalar @errors, 0, 'There are at least some errors to be found.' );
for my $error ( @errors ) {
my $filename = "t/$error.t";
ok( -e $filename, "$filename exists" );
}
HTML-Lint-2.32/t/11-test-html-lint-overload.t 0000644 0001750 0001750 00000000615 13220756434 017135 0 ustar andy andy #!perl -Tw
use strict;
use warnings;
use Test::More tests => 1;
use HTML::Lint;
use HTML::Lint::Error;
use Test::HTML::Lint;
my $lint = HTML::Lint->new();
$lint->only_types( HTML::Lint::Error::FLUFF );
# This code is invalid, but the linter should ignore it
my $chunk = << 'END';
This is a fine chunk of code
END
html_ok( $lint, $chunk, 'STRUCTUREally naughty code passed' );
HTML-Lint-2.32/t/30-test-builder.t 0000644 0001750 0001750 00000000416 12740064225 015036 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
# The test is not that html_ok() works, but that the tests=>1 gets
# acts as it should.
use Test::HTML::Lint tests=>1;
my $chunk = 'A fine chunk of code';
html_ok( $chunk );
HTML-Lint-2.32/t/api-parse-not-called.t 0000644 0001750 0001750 00000000701 13027375770 016122 0 ustar andy andy #!perl
use warnings;
use strict;
use Test::More tests => 3;
use HTML::Lint;
use HTML::Lint::HTML4;
my $lint = HTML::Lint->new;
isa_ok( $lint, 'HTML::Lint', 'Created lint object' );
$lint->newfile( '' );
$lint->eof;
my @errors = $lint->errors();
cmp_ok( scalar @errors, '>', 0, 'Should get back at least one error' );
my $error = $errors[-1];
is( $error->errcode, 'api-parse-not-called', 'The last error in the list is the API error' );
HTML-Lint-2.32/t/pod.t 0000644 0001750 0001750 00000000356 13220756434 013004 0 ustar andy andy #!perl -Tw
use strict;
use warnings;
use Test::More;
if ( !eval 'use Test::Pod 1.14; 1;' ) { ## no critic ( BuiltinFunctions::ProhibitStringyEval )
plan skip_all => 'Test::Pod 1.14 required for testing POD';
}
all_pod_files_ok();
HTML-Lint-2.32/t/elem-nonrepeatable.t 0000644 0001750 0001750 00000000610 13220756434 015752 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'elem-nonrepeatable' => qr/\Q is not repeatable, but already appeared at (3:9)/i ],
], [] );
__DATA__
Test stuffAs if one title isn't enough
This is my paragraph
HTML-Lint-2.32/t/text-unknown-entity.t 0000644 0001750 0001750 00000001376 13220756434 016220 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
checkit( [
[ 'text-unknown-entity' => qr/Entity &metalhorns; is unknown/ ],
], [] );
__DATA__
Ace of ♠: A tribute to Motörhead. ® &metalhorns;
Thanks for visiting Ace of ♠
Here's an awesome link to "You Better Swim" from the SpongeBob movie.
HTML-Lint-2.32/t/Util.pm 0000644 0001750 0001750 00000002562 13220756434 013311 0 ustar andy andy package Util;
use parent 'Exporter';
use warnings;
use strict;
use Test::More;
use HTML::Lint;
our @EXPORT = qw(
checkit
);
sub checkit {
my @expected = @{+shift};
my @linesets = @_;
plan( tests => 3*(scalar @expected) + 4 );
my $lint = HTML::Lint->new;
isa_ok( $lint, 'HTML::Lint', 'Created lint object' );
my $n;
for my $set ( @linesets ) {
++$n;
$lint->newfile( "Set #$n" );
$lint->parse( $_ ) for @{$set};
$lint->eof;
}
my @errors = $lint->errors();
is( scalar @errors, scalar @expected, 'Right # of errors' );
while ( @errors && @expected ) {
my $error = shift @errors;
isa_ok( $error, 'HTML::Lint::Error' );
my $expected = shift @expected;
is( $error->errcode, $expected->[0], 'Error codes match' );
my $match = $expected->[1];
if ( ref($match) eq 'Regexp' ) {
like( $error->as_string, $match, 'Error matches regex' );
}
else {
is( $error->as_string, $match, 'Error matches string' );
}
}
my $dump;
is( scalar @errors, 0, 'No unexpected errors found' ) or $dump = 1;
is( scalar @expected, 0, 'No expected errors missing' ) or $dump = 1;
if ( $dump && @errors ) {
diag( 'Leftover errors...' );
diag( $_->as_string ) for @errors;
}
return;
}
1; # happy
HTML-Lint-2.32/t/attr-invalid-entity.t 0000644 0001750 0001750 00000000566 13224570052 016127 0 ustar andy andy #!perl
use warnings;
use strict;
use lib 't/';
use Util;
# We used to have attr-invalid-entity if the entities had an invalid value, but we no longer do.
checkit( [
], [] );
__DATA__
Test stuff
HTML-Lint-2.32/META.yml 0000664 0001750 0001750 00000001634 13313263531 013037 0 ustar andy andy ---
abstract: 'check for HTML errors in a string or file'
author:
- 'Andy Lester '
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.143240'
license: artistic_2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: HTML-Lint
no_index:
directory:
- t
- inc
requires:
Exporter: '0'
File::Find: '0'
HTML::Entities: '0'
HTML::Parser: '3.47'
HTML::Tagset: '3.03'
Test::Builder: '0'
Test::Builder::Tester: '0'
Test::More: '0'
perl: '5.006'
resources:
bugtracker: https://github.com/petdance/html-lint/issues
homepage: http://search.cpan.org/dist/html-lint
license: http://www.opensource.org/licenses/artistic-license-2.0.php
repository: https://github.com/petdance/html-lint
version: '2.32'
HTML-Lint-2.32/lib/ 0000755 0001750 0001750 00000000000 13313263531 012326 5 ustar andy andy HTML-Lint-2.32/lib/Test/ 0000755 0001750 0001750 00000000000 13313263531 013245 5 ustar andy andy HTML-Lint-2.32/lib/Test/HTML/ 0000755 0001750 0001750 00000000000 13313263531 014011 5 ustar andy andy HTML-Lint-2.32/lib/Test/HTML/Lint.pm 0000644 0001750 0001750 00000012211 13313263060 015247 0 ustar andy andy package Test::HTML::Lint;
use warnings;
use strict;
use Test::Builder;
use Exporter;
use HTML::Lint;
use vars qw( @ISA $VERSION @EXPORT );
@ISA = qw( HTML::Parser Exporter );
=head1 NAME
Test::HTML::Lint - Test::More-style wrapper around HTML::Lint
=head1 VERSION
Version 2.32
=cut
$VERSION = '2.32';
my $Tester = Test::Builder->new;
=head1 SYNOPSIS
use Test::HTML::Lint tests => 4;
my $table = build_display_table();
html_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
@EXPORT = qw(
html_ok
html_fragment_ok
);
sub import {
my $self = shift;
my $pack = caller;
$Tester->exported_to($pack);
$Tester->plan(@_);
$self->export_to_level(1, $self, @EXPORT);
return;
}
=head2 html_ok( [$lint, ] $html, $name )
Checks to see if C<$html> is a valid HTML document, including checks
for having C<< >>, C<< >>, C<< > >> and
C<< >> tags.
If you're checking something that is only a fragment of an HTML document,
use C.
If you pass an HTML::Lint object, C will use that for its
settings.
my $lint = new HTML::Lint( only_types => STRUCTURE );
html_ok( $lint, $content, "Web page passes structural tests only" );
Otherwise, it will use the default rules.
html_ok( $content, "Web page passes ALL tests" );
Note that if you pass in your own HTML::Lint object, C
will clear its errors before using it.
=cut
sub html_ok {
my $lint;
if ( ref($_[0]) eq 'HTML::Lint' ) {
$lint = shift;
$lint->newfile();
$lint->clear_errors();
}
else {
$lint = HTML::Lint->new;
}
my $html = shift;
my $name = shift;
my $ok = defined $html;
if ( !$ok ) {
$Tester->ok( 0, $name );
}
else {
$lint->parse( $html );
$lint->eof();
my $nerr = scalar $lint->errors;
$ok = !$nerr;
$Tester->ok( $ok, $name );
if ( !$ok ) {
my $msg = 'Errors:';
$msg .= " $name" if $name;
$Tester->diag( $msg );
$Tester->diag( $_->as_string ) for $lint->errors;
}
}
return $ok;
}
=head2 html_fragment_ok( [$lint, ] $html, $name )
Checks that C<$fragment> is valid HTML, but not necessarily a valid
HTML document.
For example, this is a valid fragment, but not a valid HTML document:
Lorem ipsum
because it doesn't contain C<< >> and C<< >> tags. If you
want to check that it is a valid document, use C.
If you pass an HTML::Lint object, C will use that for its
settings.
my $lint = new HTML::Lint( only_types => STRUCTURE );
html_fragment_ok( $lint, $content, 'Web page passes structural tests only' );
Otherwise, it will use the default rules.
html_fragment_ok( $content, 'Fragment passes ALL tests' );
Note that if you pass in your own HTML::Lint object, C
will clear its errors before using it.
=cut
sub html_fragment_ok {
my $lint;
if ( ref($_[0]) eq 'HTML::Lint' ) {
$lint = shift;
$lint->newfile();
$lint->clear_errors();
}
else {
$lint = HTML::Lint->new;
}
my $html = shift;
my $name = shift;
my $ok = defined $html;
if ( !$ok ) {
$Tester->ok( 0, $name );
}
else {
$lint->parse( $html );
$lint->eof();
# Ignore doc-level errors.
my @errors = grep { $_->errcode ne 'doc-tag-required' } $lint->errors;
my $nerr = @errors;
$ok = !$nerr;
$Tester->ok( $ok, $name );
if ( !$ok ) {
my $msg = 'Errors:';
$msg .= " $name" if $name;
$Tester->diag( $msg );
$Tester->diag( $_->as_string ) for @errors;
}
}
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 TO DO
There needs to be a C to check that the HTML is a
self-contained, well-formed table, and then a comparable one for
C.
If you think this module should do something that it doesn't do at the
moment please let me know.
=head1 ACKNOWLEDGEMENTS
Thanks to chromatic and Michael G Schwern for the excellent Test::Builder,
without which this module wouldn't be possible.
Thanks to Adrian Howard for writing Test::Exception, from which most of
this module is taken.
=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;
HTML-Lint-2.32/lib/HTML/ 0000755 0001750 0001750 00000000000 13313263531 013072 5 ustar andy andy HTML-Lint-2.32/lib/HTML/Lint.pm 0000644 0001750 0001750 00000022236 13313263060 014340 0 ustar andy andy package HTML::Lint;
use warnings;
use strict;
use HTML::Lint::Error;
use HTML::Lint::Parser ();
use HTML::Entities ();
=head1 NAME
HTML::Lint - check for HTML errors in a string or file
=head1 VERSION
Version 2.32
=cut
our $VERSION = '2.32';
=head1 SYNOPSIS
my $lint = HTML::Lint->new;
$lint->only_types( HTML::Lint::Error::STRUCTURE );
# Parse lines of data.
$lint->newfile( $filename );
while ( my $line = <> ) {
$lint->parse( $line );
}
$lint->eof();
# Or, parse an entire file at once.
$lint->parse_file( $filename );
# Fetch the errors that the linter found.
my $error_count = $lint->errors;
foreach my $error ( $lint->errors ) {
print $error->as_string, "\n";
}
HTML::Lint also comes with a wrapper program called F that handles
linting from the command line:
$ weblint http://www.cnn.com/
http://www.cnn.com/ (395:83) tag has no HEIGHT and WIDTH attributes.
http://www.cnn.com/ (395:83) does not have ALT text defined
http://www.cnn.com/ (396:217) Unknown element
http://www.cnn.com/ (396:241) with no opening
http://www.cnn.com/ (842:7) target attribute in is repeated
And finally, you can also get L that passes any
mod_perl-generated code through HTML::Lint and get it dumped into your
Apache F.
[Mon Jun 3 14:03:31 2002] [warn] /foo.pl (1:45)
with no opening
[Mon Jun 3 14:03:31 2002] [warn] /foo.pl (1:49) Unknown element
[Mon Jun 3 14:03:31 2002] [warn] /foo.pl (1:56) Unknown attribute "x" for tag
=cut
=head1 METHODS
NOTE: Some of these methods mirror L's methods, but HTML::Lint
is not a subclass of HTML::Parser.
=head2 new()
Create an HTML::Lint object, which inherits from HTML::Parser.
You may pass the types of errors you want to check for in the
C parm.
my $lint = HTML::Lint->new( only_types => HTML::Lint::Error::STRUCTURE );
If you want more than one, you must pass an arrayref:
my $lint = HTML::Lint->new(
only_types => [HTML::Lint::Error::STRUCTURE, HTML::Lint::Error::FLUFF] );
=cut
sub new {
my $class = shift;
my %args = @_;
my $self = {
_errors => [],
_types => [],
};
bless $self, $class;
if ( my $only = $args{only_types} ) {
$self->only_types( ref $only eq 'ARRAY' ? @{$only} : $only );
delete $args{only_types};
}
warn "Unknown argument $_\n" for keys %args;
return $self;
}
=head2 $lint->parser()
Returns the parser object for this object, creating one if necessary.
=cut
sub parser {
my $self = shift;
if ( not $self->{_parser} ) {
$self->{_parser} = HTML::Lint::Parser->new( sub { $self->gripe( @_ ) } );
$self->{_parser}->ignore_elements( qw(script style) );
}
return $self->{_parser};
}
=head2 $lint->parse( $text )
=head2 $lint->parse( $code_ref )
Passes in a chunk of HTML to be linted, either as a piece of text,
or a code reference.
See L's C method for details.
=cut
sub parse {
my $self = shift;
my $rc = $self->parser->parse( @_ );
$self->{_parse_called} = 1;
return $rc;
}
=head2 $lint->parse_file( $file )
Analyzes HTML directly from a file. The C<$file> argument can be a filename,
an open file handle, or a reference to an open file handle.
See L's C method for details.
=cut
sub parse_file {
my $self = shift;
my $rc = $self->parser->parse_file( @_ );
$self->{_parse_called} = 1;
$self->eof;
return $rc;
}
=head2 $lint->eof()
Signals the end of a block of text getting passed in. This must be
called to make sure that all parsing is complete before looking at errors.
Any parameters (and there shouldn't be any) are passed through to
HTML::Parser's eof() method.
=cut
sub eof { ## no critic ( Subroutines::ProhibitBuiltinHomonyms )
my $self = shift;
my $rc;
my $parser = $self->parser;
if ( $parser ) {
$rc = $parser->eof(@_);
delete $self->{_parser};
$self->{_eof_called} = 1;
}
return $rc;
}
=head2 $lint->errors()
In list context, C returns all of the errors found in the
parsed text. Each error is an object of the type L.
In scalar context, it returns the number of errors found.
=cut
sub errors {
my $self = shift;
if ( !$self->{_parse_called} ) {
$self->gripe( 'api-parse-not-called' );
}
elsif ( !$self->{_eof_called} ) {
$self->gripe( 'api-eof-not-called' );
}
if ( wantarray ) {
return @{$self->{_errors}};
}
else {
return scalar @{$self->{_errors}};
}
}
=head2 $lint->clear_errors()
Clears the list of errors, in case you want to print and clear, print and clear.
=cut
sub clear_errors {
my $self = shift;
$self->{_errors} = [];
return;
}
=head2 $lint->only_types( $type1[, $type2...] )
Specifies to only want errors of a certain type.
$lint->only_types( HTML::Lint::Error::STRUCTURE );
Calling this without parameters makes the object return all possible
errors.
The error types are C, C and C.
See L for details on these types.
=cut
sub only_types {
my $self = shift;
$self->{_types} = [@_];
return;
}
=head2 $lint->gripe( $errcode, [$key1=>$val1, ...] )
Adds an error message, in the form of an L object,
to the list of error messages for the current object. The file,
line and column are automatically passed to the L
constructor, as well as whatever other key value pairs are passed.
For example:
$lint->gripe( 'attr-repeated', tag => $tag, attr => $attr );
Usually, the user of the object won't call this directly, but just
in case, here you go.
=cut
sub gripe {
my $self = shift;
my $error = HTML::Lint::Error->new(
$self->{_file}, $self->parser->{_line}, $self->parser->{_column}, @_ );
my @keeps = @{$self->{_types}};
if ( !@keeps || $error->is_type(@keeps) ) {
push( @{$self->{_errors}}, $error );
}
return;
}
=head2 $lint->newfile( $filename )
Call C whenever you switch to another file in a batch
of linting. Otherwise, the object thinks everything is from the
same file. Note that the list of errors is NOT cleared.
Note that I<$filename> does NOT need to match what's put into C
or C. It can be a description, a URL, or whatever.
You should call C even if you are only validating one file. If
you do not call C then your errors will not have a filename
attached to them.
=cut
sub newfile {
my $self = shift;
my $file = shift;
delete $self->{_parser};
delete $self->{_parse_called};
delete $self->{_eof_called};
$self->{_file} = $file;
$self->{_line} = 0;
$self->{_column} = 0;
$self->{_first_seen} = {};
return $self->{_file};
} # newfile
1;
=head1 MODIFYING HTML::LINT'S BEHAVIOR
Sometimes you'll have HTML that for some reason cannot conform to
HTML::Lint's expectations. For those instances, you can use HTML
comments to modify HTML::Lint's behavior.
Say you have an image where for whatever reason you can't get
dimensions for the image. This HTML snippet:
causes this error:
foo.html (14:20) tag has no HEIGHT and WIDTH attributes
But if for some reason you can't get those dimensions when you build
the page, you can at least stop HTML::Lint complaining about it.
If you want to turn off all HTML::Lint warnings for a block of code, use
And turn them back on with
You don't have to use "on" and "off". For "on", you can use "true"
or "1". For "off", you can use "0" or "false".
For a list of possible errors and their codes, see L,
or run F.
=head1 BUGS, WISHES AND CORRESPONDENCE
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/ or http://code.google.com/
=head1 TODO
=over 4
=item * Check for attributes that require values
=item *
s that have no rows.
=item * Form fields that aren't in a FORM
=item * DIVs with nothing in them.
=item * HEIGHT= that have percents in them.
=item * Check for goofy stuff like:
Hello Reader - Spanish Level 1 (K-3)
=back
=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, andy at petdance.com
=cut
1;
HTML-Lint-2.32/lib/HTML/Lint/ 0000755 0001750 0001750 00000000000 13313263531 014000 5 ustar andy andy HTML-Lint-2.32/lib/HTML/Lint/Parser.pm 0000644 0001750 0001750 00000024665 13313263060 015604 0 ustar andy andy package HTML::Lint::Parser;
use warnings;
use strict;
use HTML::Parser 3.20;
use HTML::Tagset 3.03;
use HTML::Lint::Error ();
use HTML::Lint::HTML4 qw( %isKnownAttribute %isRequired %isNonrepeatable %isObsolete );
use HTML::Entities qw( %char2entity %entity2char );
use parent 'HTML::Parser';
=head1 NAME
HTML::Lint::Parser - Parser for HTML::Lint. No user-serviceable parts inside.
=head1 VERSION
Version 2.32
=cut
our $VERSION = '2.32';
=head1 SYNOPSIS
See L for all the gory details.
=head1 METHODS
=head2 new( $gripe )
Constructor for the main parsing object. The I<$gripe> argument
is a coderef to a function that can handle errors from the parser.
It is only ever (so far) C.
=cut
sub new {
my $class = shift;
my $gripe = shift;
my $self =
HTML::Parser->new(
api_version => 3,
start_document_h => [ \&_start_document, 'self' ],
end_document_h => [ \&_end_document, 'self,line,column' ],
start_h => [ \&_start, 'self,tagname,line,column,@attr' ],
end_h => [ \&_end, 'self,tagname,line,column,tokenpos,@attr' ],
comment_h => [ \&_comment, 'self,tagname,line,column,text' ],
text_h => [ \&_text, 'self,text' ],
strict_names => 0,
empty_element_tags => 1,
attr_encoded => 1,
);
bless $self, $class;
$self->{_gripe} = $gripe;
$self->{_stack} = [];
$self->{_directives} = {};
return $self;
}
=head2 $parser->gripe( $errorcode, [ arg1=>val1, ...] )
Calls the passed-in gripe function.
If a given directive has been set to turn off a given message, then
the parent gripe never gets called.
=cut
sub gripe {
my $self = shift;
my $errorcode = shift;
if ( $self->_displayable( $errorcode ) ) {
$self->{_gripe}->( $errorcode, @_ );
}
return;
}
sub _displayable {
my $self = shift;
my $errorcode = shift;
my $directives = $self->{_directives};
if ( not defined $directives->{$errorcode} ) {
return 1;
}
else {
return $directives->{$errorcode};
}
}
sub _start_document {
return;
}
sub _end_document {
my ($self,$line,$column) = @_;
for my $tag ( sort keys %isRequired ) {
if ( !$self->{_first_seen}->{$tag} ) {
$self->gripe( 'doc-tag-required', tag => $tag );
}
}
return;
}
sub _start {
my ($self,$tag,$line,$column,@attr) = @_;
$self->{_line} = $line;
$self->{_column} = $column;
my $validattr = $isKnownAttribute{ $tag };
if ( $validattr ) {
my %seen;
my $i = 0;
while ( $i < @attr ) {
my ($attr,$val) = @attr[$i++,$i++];
if ( $seen{$attr}++ ) {
$self->gripe( 'attr-repeated', tag => $tag, attr => $attr );
}
if ( !$validattr->{$attr} ) {
$self->gripe( 'attr-unknown', tag => $tag, attr => $attr );
}
$self->_entity($val, 'attr');
} # while attribs
}
else {
$self->gripe( 'elem-unknown', tag => $tag );
}
$self->_element_push( $tag ) unless $HTML::Tagset::emptyElement{ $tag };
if ( my $where = $self->{_first_seen}{$tag} ) {
if ( $isNonrepeatable{$tag} ) {
$self->gripe( 'elem-nonrepeatable',
tag => $tag,
where => HTML::Lint::Error::where( @{$where} )
);
}
}
else {
$self->{_first_seen}{$tag} = [$line,$column];
}
# Call any other overloaded func
my $tagfunc = "_start_$tag";
if ( $self->can($tagfunc) ) {
$self->$tagfunc( $tag, @attr );
}
return;
}
sub _text {
my ($self,$text) = @_;
$self->_entity($text, 'text');
return;
}
sub _entity {
my ($self,$text,$type) = @_;
if ( not $self->{_entity_lookup} ) {
my @entities = sort keys %HTML::Entities::entity2char;
# Strip his semicolons
s/;$// for @entities;
$self->{_entity_lookup} = { map { ($_,1) } @entities };
}
while ( $text =~ /([^\x09\x0A\x0D -~])/g ) {
my $bad = $1;
$self->gripe(
$type . '-use-entity',
char => sprintf( '\x%02lX', ord($bad) ),
entity => $char2entity{ $bad } || '' . ord($bad) . ';',
);
}
while ( $text =~ /&([^ ;]*;?)/g ) {
my $match = $1;
if ( $match eq '' ) {
$self->gripe( $type . '-use-entity', char => '&', entity => '&' );
}
elsif ( $match !~ m/;$/ ) {
if ( exists $self->{_entity_lookup}->{$match}
|| $match =~ m/^#(\d+)$/ || $match =~ m/^#x[\dA-F]+$/i) {
$self->gripe( $type . '-unclosed-entity', entity => "&$match;" );
}
else {
$self->gripe( $type . '-unknown-entity', entity => "&$match" );
}
}
elsif ( $match =~ m/^#(\d+);$/ ) {
# All numeric entities are OK. We used to check that they were in a given range.
}
elsif ( $match =~ m/^#x([\dA-F]+);$/i ) {
# All hex entities OK. We used to check that they were in a given range.
}
else {
$match =~ s/;$//;
if ( !exists $self->{_entity_lookup}->{$match} ) {
$self->gripe( $type . '-unknown-entity', entity => "&$match;" );
}
}
}
return;
}
sub _comment {
my ($self,$tagname,$line,$column,$text) = @_;
# Look for the html-lint directives
if ( $tagname =~ m/^\s*html-lint\s*(.+)\s*$/ ) {
my $text = $1;
my @commands = split( /\s*,\s*/, $text );
for my $command ( @commands ) {
my ($directive,$value) = split( /\s*:\s*/, $command, 2 );
_trim($_) for ($directive,$value);
if ( ($directive ne 'all') &&
( not exists $HTML::Lint::Error::errors{ $directive } ) ) {
$self->gripe( 'config-unknown-directive',
directive => $directive,
where => HTML::Lint::Error::where($line,$column)
);
next;
}
my $normalized_value = _normalize_value( $value );
if ( !defined($normalized_value) ) {
$self->gripe( 'config-unknown-value',
directive => $directive,
value => $value,
where => HTML::Lint::Error::where($line,$column)
);
next;
}
if ( $directive eq 'all' ) {
for my $err ( keys %HTML::Lint::Error::errors ) {
$self->_set_directive( $err, $normalized_value );
}
}
else {
$self->_set_directive( $directive, $normalized_value );
}
}
}
return;
}
sub _set_directive {
my $self = shift;
my $which = shift;
my $what = shift;
$self->{_directives}{$which} = $what;
return;
}
sub _normalize_value {
my $what = shift;
$what = _trim( $what );
return 1 if $what eq '1' || $what eq 'on' || $what eq 'true';
return 0 if $what eq '0' || $what eq 'off' || $what eq 'false';
return undef;
}
sub _trim {
$_[0] =~ s/^\s+//;
$_[0] =~ s/\s+$//;
return $_[0];
}
sub _end { ## no critic ( Subroutines::ProhibitManyArgs ) I have no choice in what these args are.
my ($self,$tag,$line,$column,$tokenpos,@attr) = @_;
$self->{_line} = $line;
$self->{_column} = $column;
if ( !$tokenpos ) {
# This is a dummy end event for something like .
# Do nothing.
}
elsif ( $HTML::Tagset::emptyElement{ $tag } ) {
$self->gripe( 'elem-empty-but-closed', tag => $tag );
}
else {
if ( $self->_in_context($tag) ) {
my @leftovers = $self->_element_pop_back_to($tag);
for ( @leftovers ) {
my ($tag,$line,$col) = @{$_};
$self->gripe( 'elem-unclosed', tag => $tag,
where => HTML::Lint::Error::where($line,$col) )
unless $HTML::Tagset::optionalEndTag{$tag};
} # for
}
else {
$self->gripe( 'elem-unopened', tag => $tag );
}
} # is empty element
# Call any other overloaded func
my $tagfunc = "_end_$tag";
if ( $self->can($tagfunc) ) {
$self->$tagfunc( $tag, $line );
}
return;
}
sub _element_push {
my $self = shift;
for ( @_ ) {
push( @{$self->{_stack}}, [$_,$self->{_line},$self->{_column}] );
} # while
return;
}
sub _find_tag_in_stack {
my $self = shift;
my $tag = shift;
my $stack = $self->{_stack};
my $offset = @{$stack} - 1;
while ( $offset >= 0 ) {
if ( $stack->[$offset][0] eq $tag ) {
return $offset;
}
--$offset;
} # while
return;
}
sub _element_pop_back_to {
my $self = shift;
my $tag = shift;
my $offset = $self->_find_tag_in_stack($tag) or return;
my @leftovers = splice( @{$self->{_stack}}, $offset + 1 );
pop @{$self->{_stack}};
return @leftovers;
}
sub _in_context {
my $self = shift;
my $tag = shift;
my $offset = $self->_find_tag_in_stack($tag);
return defined $offset;
}
# Overridden tag-specific stuff
sub _start_img { ## no critic ( Subroutines::ProhibitUnusedPrivateSubroutines ) # Called by parser based on tag name.
my ($self,$tag,%attr) = @_;
my ($h,$w,$src) = @attr{qw( height width src )};
if ( defined $h && defined $w ) {
# Check sizes
}
else {
$self->gripe( 'elem-img-sizes-missing', src=>$src );
}
if ( not defined $attr{alt} ) {
$self->gripe( 'elem-img-alt-missing', src=>$src );
}
return;
}
sub _start_input { ## no critic ( Subroutines::ProhibitUnusedPrivateSubroutines ) # Called by parser based on tag name.
my ($self,$tag,%attr) = @_;
my ($type,$alt) = @attr{qw( type alt )};
if ( defined($type) && (lc($type) eq 'image') ) {
my $ok = defined($alt);
if ( $ok ) {
$alt =~ s/^ +//;
$alt =~ s/ +$//;
$ok = ($alt ne '');
}
if ( !$ok ) {
my $name = $attr{name};
$name = '' unless defined $name;
$self->gripe( 'elem-input-alt-missing', name => $name );
}
}
return;
}
1;
HTML-Lint-2.32/lib/HTML/Lint/HTML4.pm 0000644 0001750 0001750 00000021717 13224567121 015201 0 ustar andy andy package HTML::Lint::HTML4;
use warnings;
use strict;
=head1 NAME
HTML::Lint::HTML4 -- Rules for HTML 4 as used by HTML::Lint.
=head1 SYNOPSIS
Collection of tags and attributes for use by HTML::Lint. You can add
your own tags and attributes if you like.
# Add an attribute that your company uses.
HTML::Lint::HTML4::add_attribute( 'body', 'proprietary-attribute' );
# Add the HTML 5