HTML-Lint-2.26/ 0000755 0001750 0001750 00000000000 13031362317 011562 5 ustar andy andy HTML-Lint-2.26/MANIFEST 0000644 0001750 0001750 00000002143 13031362317 012713 0 ustar andy andy Changes
MANIFEST
Makefile.PL
README
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/LintTest.pl
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/api-eof-not-called.t
t/api-parse-not-called.t
t/attr-repeated.t
t/attr-unknown.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/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.26/Makefile.PL 0000644 0001750 0001750 00000005121 13031362031 013524 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 ',
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 {
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 lib/ bin/weblint Makefile.PL
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.26/META.json 0000664 0001750 0001750 00000003037 13031362317 013210 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.150005",
"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"
}
}
},
"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.26",
"x_serialization_backend" : "JSON::PP version 2.27300"
}
HTML-Lint-2.26/README 0000644 0001750 0001750 00000000570 12740064225 012447 0 ustar andy andy 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.com
HTML-Lint-2.26/bin/ 0000755 0001750 0001750 00000000000 13031362317 012332 5 ustar andy andy HTML-Lint-2.26/bin/weblint 0000755 0001750 0001750 00000004633 12740064225 013735 0 ustar andy andy #!/usr/bin/perl -w
use warnings;
use strict;
use Getopt::Long;
use HTML::Lint;
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?:/ ) {
eval { require LWP::Simple };
if ( $@ ) {
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;
}
}
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.26/t/ 0000755 0001750 0001750 00000000000 13031362317 012025 5 ustar andy andy HTML-Lint-2.26/t/config-unknown-directive.t 0000644 0001750 0001750 00000000740 12740064225 017134 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/text-unclosed-entity.t 0000644 0001750 0001750 00000002240 13021711774 016324 0 ustar andy andy #!perl
use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/00-load.t 0000644 0001750 0001750 00000000275 12740064225 013355 0 ustar andy andy #!perl -Tw
use Test::More tests => 2;
BEGIN {
use_ok( 'HTML::Lint' );
}
BEGIN {
use_ok( 'Test::HTML::Lint' );
}
diag( "Testing HTML::Lint $HTML::Lint::VERSION, Perl $], $^X" );
HTML-Lint-2.26/t/elem-unclosed.t 0000644 0001750 0001750 00000000655 12740064225 014757 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'elem-unclosed' => qr/\Q at (6:5) is never closed/i ],
[ 'elem-unclosed' => qr/\Q at (7:5) is never closed/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
This is another paragraph
HTML-Lint-2.26/t/attr-unknown.t 0000644 0001750 0001750 00000000734 12740064225 014670 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/12-html_fragment_ok.t 0000644 0001750 0001750 00000004342 13031362031 015746 0 ustar andy andy 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.26/t/elem-img-alt-missing.t 0000644 0001750 0001750 00000000606 12740064225 016140 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'elem-img-alt-missing' => qr/ does not have ALT text defined/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.26/t/10-test-html-lint.t 0000644 0001750 0001750 00000000532 12740064225 015320 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 3;
use Test::HTML::Lint;
BEGIN {
use_ok( '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.26/t/xhtml-html.t 0000644 0001750 0001750 00000002251 12740064225 014313 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/config-unknown-value.t 0000644 0001750 0001750 00000001245 12740064225 016273 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'config-unknown-value' => qr/Unknown value "14" for elem-img-sizes-missing directive$/ ],
], [] );
__DATA__
Test stuff
HTML-Lint-2.26/t/elem-input-alt-missing.t 0000644 0001750 0001750 00000002157 12740064225 016526 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/elem-unknown.t 0000644 0001750 0001750 00000000733 12740064225 014637 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/50-multiple-files.t 0000644 0001750 0001750 00000001752 12740064225 015377 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
my @files = get_paragraphed_files();
checkit( [
[ 'elem-unopened' => qr/<\/p> with no opening
/i ],
[ 'elem-unclosed' => qr/ at \(6:5\) is never closed/i ],
[ 'elem-unclosed' => qr/ at \(7:5\) is never closed/i ],
[ 'elem-unopened' => qr/<\/b> with no opening /i ],
], @files );
__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.26/t/elem-img-sizes-missing.t 0000644 0001750 0001750 00000001124 12740064225 016511 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/attr-repeated.t 0000644 0001750 0001750 00000000474 13027365741 014771 0 ustar andy andy use strict;
use warnings;
require 't/LintTest.pl';
checkit( [
[ 'attr-repeated' => qr/ALIGN attribute in
is repeated/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.26/t/api-eof-not-called.t 0000644 0001750 0001750 00000000727 13027375770 015574 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.26/t/40-where.t 0000644 0001750 0001750 00000002244 13027375770 013563 0 ustar andy andy use strict;
use warnings;
require 't/LintTest.pl';
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.26/t/20-error-types-skip.t 0000644 0001750 0001750 00000003111 13027375770 015700 0 ustar andy andy #!perl -Tw
use strict;
use warnings;
use Test::More tests => 10;
BEGIN { use_ok( 'HTML::Lint' ); }
BEGIN { use_ok( '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.26/t/text-invalid-entity.t 0000644 0001750 0001750 00000003065 12740064225 016143 0 ustar andy andy #!perl
use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'text-unknown-entity' => qr/Entity &metalhorns; is unknown/ ],
[ 'text-invalid-entity' => qr/Entity is invalid/ ],
[ 'text-invalid-entity' => qr/Entity is invalid/ ],
[ '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.26/t/random-nobr.t 0000644 0001750 0001750 00000000620 12740064225 014431 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/elem-unopened.t 0000644 0001750 0001750 00000000460 12740064225 014752 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'elem-unopened' => qr/<\/p> with no opening
/i ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.26/t/text-use-entity.t 0000644 0001750 0001750 00000003010 13022157553 015300 0 ustar andy andy use utf8;
use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/20-error-types-export.t 0000644 0001750 0001750 00000000643 12740064225 016251 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 5;
BEGIN { use_ok( '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.26/t/strong-id.t 0000644 0001750 0001750 00000001643 12740064225 014127 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/LintTest.pl 0000644 0001750 0001750 00000003122 13025133561 014126 0 ustar andy andy use Test::More;
use HTML::Lint;
sub checkit {
my @expected = @{+shift};
my @linesets = @_;
plan( tests => 3*(scalar @expected) + 4 );
my $lint = new HTML::Lint;
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;
}
}
# 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;
}
1; # happy
HTML-Lint-2.26/t/20-error-types.t 0000644 0001750 0001750 00000001013 12740064225 014722 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 5;
BEGIN { use_ok( '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.26/t/pod-coverage.t 0000644 0001750 0001750 00000000307 12740064225 014570 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
all_pod_coverage_ok();
HTML-Lint-2.26/t/60-add-tags.t 0000644 0001750 0001750 00000001436 12740064225 014130 0 ustar andy andy #!perl
use warnings;
use strict;
require 't/LintTest.pl';
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.26/t/elem-empty-but-closed.t 0000644 0001750 0001750 00000000477 12740064225 016342 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'elem-empty-but-closed' => qr/ is not a container -- <\/hr> is not allowed/ ],
], [] );
__DATA__
Test stuffThis is a bad paragraph
HTML-Lint-2.26/t/doc-tag-required.t 0000644 0001750 0001750 00000000442 13025133062 015342 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'doc-tag-required' => qr/ tag is required/ ],
], [] );
__DATA__
Test stuff
This is my paragraph
HTML-Lint-2.26/t/02-versions.t 0000644 0001750 0001750 00000000632 12740064225 014305 0 ustar andy andy #!perl -Tw
use warnings;
use strict;
use Test::More tests => 5;
BEGIN {
use_ok( 'HTML::Lint::Parser' );
}
BEGIN {
use_ok( 'HTML::Lint' );
}
BEGIN {
use_ok( '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.26/t/01-coverage.t 0000644 0001750 0001750 00000000636 12740064225 014233 0 ustar andy andy #!perl -Tw
# This test verifies that there is a t/*.t file for every possible Lint error.
use Test::More 'no_plan';
BEGIN {
use_ok( 'HTML::Lint::Error' );
}
my @errors = do { no warnings; 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.26/t/11-test-html-lint-overload.t 0000644 0001750 0001750 00000000702 12740064225 017131 0 ustar andy andy #!perl -Tw
use strict;
use warnings;
use Test::More tests => 4;
BEGIN { use_ok( 'Test::HTML::Lint' ); }
BEGIN { use_ok( 'HTML::Lint' ); }
BEGIN { use_ok( 'HTML::Lint::Error' ); }
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.26/t/30-test-builder.t 0000644 0001750 0001750 00000000416 12740064225 015041 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.26/t/api-parse-not-called.t 0000644 0001750 0001750 00000000701 13027375770 016125 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.26/t/pod.t 0000644 0001750 0001750 00000000215 12740064225 012775 0 ustar andy andy #!perl -Tw
use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();
HTML-Lint-2.26/t/elem-nonrepeatable.t 0000644 0001750 0001750 00000000557 12740064225 015763 0 ustar andy andy use warnings;
use strict;
require 't/LintTest.pl';
checkit( [
[ 'elem-nonrepeatable' => qr/ is not repeatable, but already appeared at \(3:2\)/i ],
], [] );
__DATA__
Test stuffAs if one title isn't enough
This is my paragraph
HTML-Lint-2.26/t/text-unknown-entity.t 0000644 0001750 0001750 00000001373 12740064225 016214 0 ustar andy andy #!perl
use warnings;
use strict;
require 't/LintTest.pl';
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.26/META.yml 0000664 0001750 0001750 00000001706 13031362317 013041 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.150005'
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'
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.26'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
HTML-Lint-2.26/lib/ 0000755 0001750 0001750 00000000000 13031362317 012330 5 ustar andy andy HTML-Lint-2.26/lib/Test/ 0000755 0001750 0001750 00000000000 13031362317 013247 5 ustar andy andy HTML-Lint-2.26/lib/Test/HTML/ 0000755 0001750 0001750 00000000000 13031362317 014013 5 ustar andy andy HTML-Lint-2.26/lib/Test/HTML/Lint.pm 0000644 0001750 0001750 00000012243 13031362237 015262 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.26
=cut
$VERSION = '2.26';
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/ or http://code.google.com/
=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-2016 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.26/lib/HTML/ 0000755 0001750 0001750 00000000000 13031362317 013074 5 ustar andy andy HTML-Lint-2.26/lib/HTML/Lint.pm 0000644 0001750 0001750 00000022147 13031362223 014342 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.26
=cut
our $VERSION = '2.26';
=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;
return $self->parser->parse_file( @_ );
}
=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 {
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 * Check for valid entities, and that they end with semicolons
=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-2016 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.26/lib/HTML/Lint/ 0000755 0001750 0001750 00000000000 13031362317 014002 5 ustar andy andy HTML-Lint-2.26/lib/HTML/Lint/Parser.pm 0000644 0001750 0001750 00000023627 13031362213 015601 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::HTML4 qw( %isKnownAttribute %isRequired %isNonrepeatable %isObsolete );
use HTML::Entities qw( %char2entity %entity2char );
use base 'HTML::Parser';
=head1 NAME
HTML::Lint::Parser - Parser for HTML::Lint. No user-serviceable parts inside.
=head1 VERSION
Version 2.26
=cut
our $VERSION = '2.26';
=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,
);
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 );
}
} # 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) = @_;
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(
'text-use-entity',
char => sprintf( '\x%02lX', ord($bad) ),
entity => $char2entity{ $bad } || '' . ord($bad) . ';',
);
}
while ( $text =~ /&([^ ;]*;?)/g ) {
my $match = $1;
if ( $match eq '' ) {
$self->gripe( 'text-use-entity', char => '&', entity => '&' );
} elsif ( $match !~ m/;$/ ) {
if ( exists $self->{_entity_lookup}->{$match}
|| $match =~ m/^#(\d+)$/ || $match =~ m/^#x[\dA-F]+$/i) {
$self->gripe( 'text-unclosed-entity', entity => "&$match;" );
} else {
$self->gripe( 'text-unknown-entity', entity => "&$match" );
}
} elsif ( $match =~ m/^#(\d+);$/ ) {
if ( $1 > 65536 ) {
$self->gripe( 'text-invalid-entity', entity => "&$match" );
}
} elsif ( $match =~ m/^#x([\dA-F]+);$/i ) {
if ( length($1) > 4 ) {
$self->gripe( 'text-invalid-entity', entity => "&$match" );
}
} else {
$match =~ s/;$//;
unless ( exists $self->{_entity_lookup}->{$match} ) {
$self->gripe( 'text-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 =~ /^(?:1|on|true)$/;
return 0 if $what =~ /^(?:0|off|false)$/;
return undef;
}
sub _trim {
$_[0] =~ s/^\s+//;
$_[0] =~ s/\s+$//;
return $_[0];
}
sub _end {
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 {
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 {
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.26/lib/HTML/Lint/HTML4.pm 0000644 0001750 0001750 00000021714 13026654363 015206 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