You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
275 lines
6.5 KiB
275 lines
6.5 KiB
package Test::HTML::W3C;
|
|
|
|
use strict;
|
|
use vars qw($VERSION @EXPORT);
|
|
$VERSION = "0.02";
|
|
|
|
=head1 NAME
|
|
|
|
Test::HTML::W3C - Perform W3C HTML validation testing
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Test::W3C::HTML tests => $test_count;
|
|
# or
|
|
use Test::W3C::HTML 'show_detail';
|
|
# or when using both
|
|
use Test::W3C::HTML tests => $test_count, 'show_detail';
|
|
|
|
is_valid_markup($my_html_scalar);
|
|
|
|
is_valid_file("/path/to/my/file.html");
|
|
|
|
is_valid("http://example.com");
|
|
|
|
# Get the underlying WebService:;Validator::W3C::HTML object
|
|
my $validator = validator();
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The purpose of this module is to provide a wide range of testing
|
|
utilities. Various ways to say "ok" with better diagnostics,
|
|
facilities to skip tests, test future features and compare complicated
|
|
data structures. While you can do almost anything with a simple
|
|
C<ok()> function, it doesn't provide good diagnostic output.
|
|
|
|
=head1 ABUSE
|
|
|
|
Please keep in mind that the W3C validation pages and services are
|
|
a shared resource. If you plan to do many many tests, please consider
|
|
using your own installation of the validation programs, and then use
|
|
your local install by modifying the local validtor:
|
|
|
|
my $v = validator();
|
|
$v->validator_uri($my_own_validator);
|
|
|
|
See the documentation for WebService:;Validator::W3C::HTML and the W3C's
|
|
site at http://validator.w3.org/ for details
|
|
|
|
=over 4
|
|
|
|
=cut
|
|
|
|
use WebService::Validator::HTML::W3C;
|
|
use base qw(Test::Builder::Module);
|
|
@EXPORT = qw(
|
|
plan
|
|
diag_html
|
|
is_valid_markup
|
|
is_valid_file
|
|
is_valid
|
|
validator
|
|
);
|
|
|
|
my $v = WebService::Validator::HTML::W3C->new();
|
|
my $not_checked = 1;
|
|
my $show_detail = 0;
|
|
|
|
sub import_extra {
|
|
my ($class, $list) = @_;
|
|
my @other = ();
|
|
my $idx = 0;
|
|
while( $idx <= $#{$list} ) {
|
|
my $item = $list->[$idx];
|
|
|
|
if( defined $item and $item eq 'show_detail' ) {
|
|
$show_detail = 1;
|
|
$v = WebService::Validator::HTML::W3C->new(detailed => 1);
|
|
} else {
|
|
push @other, $item;
|
|
}
|
|
$idx++;
|
|
}
|
|
@$list = @other;
|
|
}
|
|
|
|
=item validator();
|
|
|
|
B<Description:> Returns the underlying WebService::Validator::HTML::W3C object
|
|
|
|
B<Parameters:> None.
|
|
|
|
B<Returns:> $validator
|
|
|
|
=cut
|
|
|
|
sub validator {
|
|
return $v;
|
|
}
|
|
|
|
|
|
=item plan();
|
|
|
|
B<Description:> Returns the underlying WebService::Validator::HTML::W3C object
|
|
|
|
B<Parameters:> None.
|
|
|
|
B<Returns:> $validator
|
|
|
|
=cut
|
|
|
|
sub plan {
|
|
__PACKAGE__->builder->plan(@_);
|
|
}
|
|
|
|
sub _check_plan {
|
|
$not_checked = 0;
|
|
if (! __PACKAGE__->builder->has_plan()) {
|
|
plan("no_plan");
|
|
}
|
|
}
|
|
|
|
=item is_valid_markup($markup[, $name]);
|
|
|
|
B<Description:> is_valid_markup tests whether the text in the provided scalar
|
|
value correctly validates according to the W3C specifications. This is useful
|
|
if you have markup stored in a scalar that you wish to test that you might get
|
|
from using LWP or WWW::Mechanize for example...
|
|
|
|
B<Parameters:> $markup, a scalar containing the data to test, $name, an
|
|
optional descriptive test name.
|
|
|
|
B<Returns:> None.
|
|
|
|
=cut
|
|
|
|
sub is_valid_markup {
|
|
_check_plan() if $not_checked;
|
|
my ($markup, $message) = @_;
|
|
if ($v->validate_markup($markup)) {
|
|
_result($v, $message);
|
|
} else {
|
|
_validator_err($v, "markup");
|
|
}
|
|
}
|
|
|
|
=item is_valid_file($path[, $name]);
|
|
|
|
B<Description:> is_valid_file works the same way as is_valid_markup, except that
|
|
you can specify the text to validate with the path to a filename. This is useful
|
|
if you have pregenerated all your HTML files locally, and now wish to test them.
|
|
|
|
B<Parameters:> $path, a scalar, $name, an optional descriptive test name.
|
|
|
|
B<Returns:> None.
|
|
|
|
=cut
|
|
|
|
sub is_valid_file {
|
|
my ($file, $message) = @_;
|
|
_check_plan() if $not_checked;
|
|
if ($v->validate_file($file)) {
|
|
_result($v, $message);
|
|
} else {
|
|
_validator_err($v, "file");
|
|
}
|
|
}
|
|
|
|
|
|
=item is_valid($url[, $name]);
|
|
|
|
B<Description:> is_valid, again, works very similarly to the is_valid_file and
|
|
is_valid_file, except you specify a document that is already online with its
|
|
URL. This can be useful if you wish to periodically test a website or webpage
|
|
that dynamically changes over time for example, like a blog or a wiki, without
|
|
first saving the html to a file using your browswer, or a utility such as wget.
|
|
|
|
B<Parameters:> $url, a scalar, $name, an optional descriptive test name.
|
|
|
|
B<Returns:> None.
|
|
|
|
=cut
|
|
|
|
sub is_valid {
|
|
my ($uri, $message) = @_;
|
|
_check_plan() if $not_checked;
|
|
if ($v->validate($uri)) {
|
|
_result($v, $message);
|
|
} else {
|
|
_validator_err($v, "URI");
|
|
}
|
|
}
|
|
|
|
sub _validator_err {
|
|
my ($validator, $type) = @_;
|
|
__PACKAGE__->builder->ok(0, "Failed to validate $type.");
|
|
__PACKAGE__->builder->diag($v->validator_error());
|
|
}
|
|
|
|
sub _result {
|
|
my ($validator, $message) = @_;
|
|
if ($validator->is_valid()) {
|
|
__PACKAGE__->builder->ok(1, $message);
|
|
} else {
|
|
my $num = $validator->num_errors();
|
|
my $plurality = ($num == 1) ? "error" : "errors";
|
|
__PACKAGE__->builder->ok(0, $message . " ($num $plurality).");
|
|
}
|
|
}
|
|
|
|
|
|
=item diag_html($url);
|
|
|
|
B<Description:> If you want to display the actual errors reported by
|
|
the service for a particular test, you can use the diag_html function.
|
|
Please note that you must have imported 'show_detail' for this to
|
|
work properly.
|
|
|
|
use Test::HTML::W3C 'show_detail';
|
|
|
|
is_valid_markup("<html></html">, "My simple test") or diag_html();
|
|
|
|
B<Parameters:> $url, a scalar.
|
|
|
|
B<Returns:> None.
|
|
|
|
=cut
|
|
|
|
sub diag_html {
|
|
my $tb = __PACKAGE__->builder();
|
|
if ($show_detail) {
|
|
my @errs = $v->errors();
|
|
my $e;
|
|
foreach my $error ( @{$v->errors()} ) {
|
|
$e .= sprintf("%s at line %d\n", $error->msg, $error->line);
|
|
}
|
|
$tb->diag($e);
|
|
} else {
|
|
$tb->diag("You need to import 'show_detail' in order to call diag_html\n");
|
|
}
|
|
}
|
|
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Test::Builder::Module> for creating your own testing modules.
|
|
|
|
L<Test::More> for another popular testing framework, also based on
|
|
Test::Builder
|
|
|
|
L<Test::Harness> for detils about how test results are interpreted.
|
|
|
|
=head1 AUTHORS
|
|
|
|
Victor E<lt>victor73@gmail.comE<gt> with inspiration
|
|
from the authors of the Test::More and WebService::Validator::W3C:HTML
|
|
modules.
|
|
|
|
=head1 BUGS
|
|
|
|
See F<http://rt.cpan.org> to report and view bugs.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright 2006 by Victor E<lt>victor73@gmail.comE<gt>.
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself.
|
|
|
|
See F<http://www.perl.com/perl/misc/Artistic.html>
|