[code-review] WebService::Validator::HTML::W3C

--b5gNqxB1S1yM7hjW
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Hi,

Any thoughts/improvements/whatever on the attached?

FWIW it validates URIs against the W3Cs markup validator.

cheers

Struan

--b5gNqxB1S1yM7hjW
Content-Type: application/x-perl
Content-Disposition: attachment; filename="W3C.pm"
Content-Transfer-Encoding: quoted-printable

# $Id: W3C.pm,v 1.3 2003/11/14 16:52:05 struan Exp $=0Apackage WebService::=
Validator::HTML::W3C;=0A=0Ause strict;=0Ause LWP::UserAgent;=0Ause URI::Esc=
ape;=0A=0Ause vars qw( $VERSION $VALIDATOR_URI $HTTP_TIMEOUT );=0A=0A$VERSI=
ON =3D 0.01;=0A$VALIDATOR_URI =3D 'http://validator.w3.org/check';=0A$HTTP_=
TIMEOUT =3D 30;=0A=0A=3Dhead1 NAME=0A=0AWebService::Validator::HTML::W3C=0A=
=0A=3Dhead1 SYNOPSIS=0A=0A    use WebService::Validator::HTML::W3C;=0A=0A  =
  my $v =3D WebService::Validator::HTML::W3C->new();=0A=0A    if ( $v->vali=
date("http://www.example.com/") ) {=0A        if ( $v->valid ) {=0A        =
    printf ("%s is a valid website\n", $v->uri);=0A            } else {=0A =
           printf ("%s is not a valid website\n", $v->uri);=0A            f=
oreach $error ( $v->errors ) {=0A                printf("%s at line %n\n", =
$error->{description},=0A                                          $error->=
{line_no});=0A            }=0A        }=0A    } else {=0A        printf ("F=
ailed to validate the website: %s\n", $v->validate_error);=0A    }=0A=0A=3D=
head1 DESCRIPTION=0A=0AWebService::Validator::HTML::W3C provides access to =
the W3C's online=0AMarkup validator. As well as reporting on whether a page=
 is valid it =0Aalso provides access to a detailed list of the errors and w=
here in=0Athe validated document they occur.=0A=0A=3Dhead1 METHODS=0A=0A=3D=
head2 new=0A=0A    my $v =3D WebService::Validator::HTML::W3C->new();=0A=0A=
Returns a new instance of the WebService::Validator::HTML::W3C object. =0A=
=0A=3Dhead2 options=0A=0AThere are various options that can be set when cre=
ating the Validator =0Aobject like so:=0A=0A    my $v =3D WebService::Valid=
ator::HTML::W3C->new( http_timeout =3D> 20 );=0A=0A=3Dover 4=0A=0A=3Ditem v=
alidator_uri=0A=0AThe URI of the validator to use.  By default this accesse=
s the W3Cs validator at http://validator.w3.org/check. If you have a local =
installation of the validator ( recommended if you wish to do a lot of test=
ing ) or wish to use a validator at another location then you can use this =
option. Please note that you need to use the full path to the validator cgi=
.=0A=0A=3Ditem http_timeout=0A=0AHow long (in seconds) to wait for the HTTP=
 connection to timeout when=0Acontacting the validator. By default this is =
30 seconds.=0A=0A=3Dback =0A=0A=3Dcut=0A=0Asub new {=0A    my $ref =3D shif=
t;=0A    my $class =3D ref $ref || $ref;=0A    my $obj =3D {};=0A    bless =
$obj, $class;=0A    $obj->_init(@_);=0A    return $obj;=0A}=0A=0Asub _init =
{=0A    my $self =3D shift;=0A    my %args =3D @_;=0A=0A    $self->http_tim=
eout($args{http_timeout} || $HTTP_TIMEOUT);=0A    $self->validator_uri($arg=
s{validator_uri} || $VALIDATOR_URI);=0A    $self->_http_method($args{detail=
ed} ? 'GET' : 'HEAD');=0A    $self->_debug($args{debug}) if $args{debug};=
=0A}=0A=0A=3Dhead2 validate=0A=0A    $v->validate( 'http:://www.example.com=
/' );=0A=0AValidate a URI. Returns 0 if the validation fails (e.g if the =
=0Avalidator cannot be reached), otherwise 1.=0A=0A=3Dcut=0A=0Asub validate=
 {=0A    my $self =3D shift;=0A    my $uri =3D shift;=0A=0A    unless ( $ur=
i ) {=0A        $self->validator_error("You need to supply a URI to validat=
e");=0A        return 0;=0A    }=0A=0A    unless ( $uri =3D~ m(^.*?://) ) {=
=0A        $self->validator_error("You need to supply a URI schema (e.g htt=
p)");=0A        return 0;=0A    }=0A=0A    my $uri_orig =3D $uri;=0A    # c=
reating the HTTP query string with all parameters=0A    my $req_uri =3D joi=
n('', =0A                        "?uri=3D",=0A                        uri_e=
scape($uri),=0A                        ";output=3Dxml"=0A                  =
  );=0A    $req_uri=3D $self->validator_uri . $req_uri;=0A=0A    my $method=
 =3D $self->_http_method();=0A    my $ua =3D LWP::UserAgent->new( timeout =
=3D> $self->http_timeout );=0A    my $request =3D new HTTP::Request($method=
, "$req_uri");=0A    my $response =3D $ua->simple_request($request);=0A=0A =
   if ($response->is_success) # not an error, we could contact the server=
=0A    {=0A        # set both valid and error number according to response=
=0A        my $valid =3D $response->header('X-W3C-Validator-Status');=0A   =
     my $valid_err_num =3D $response->header('X-W3C-Validator-Errors');=0A =
       =0A        $self->_content( $response->content() ) =0A            if=
 $self->_http_method() !~ /HEAD/;=0A        =0A        # we know the valida=
tor has been able to (in)validate if =0A        # $self->valid is not NULL=
=0A        =0A        if ( $valid and $valid_err_num ) {=0A            $sel=
f->is_valid(0);=0A            $self->num_errors($valid_err_num);=0A        =
    $self->uri($uri_orig);=0A            return 1;=0A        } elsif ( !def=
ined $valid ) {=0A            $self->validator_error('Not a W3C Validator o=
r Bad URI');=0A            return 0;=0A        } elsif ( $valid =3D~ /\bval=
id\b/i ) {=0A            $self->is_valid(1);=0A            $self->num_error=
s($valid_err_num);=0A            $self->uri($uri_orig);=0A            retur=
n 1;=0A        }=0A    } else {=0A        $self->validator_error('Could not=
 contact validator');=0A        return 0;=0A    }=0A}=0A=0A=0A=3Dhead2 is_v=
alid =0A=0A    $v->is_valid;=0A=0AReturns true (1) if the URI validated oth=
erwise 0.=0A=0A=3Dcut=0A=0Asub is_valid {=0A    my $self =3D shift;=0A    m=
y $valid =3D shift;=0A    return $self->_accessor('valid', $valid);=0A}=0A=
=0A=3Dhead2 uri=0A=0A    $v->uri();=0A=0AReturns the URI of the last page o=
n which validation suceeded.=0A=0A=3Dcut=0A=0Asub uri {=0A    my $self =3D =
shift;=0A    my $uri =3D shift;=0A    return $self->_accessor('uri', $uri);=
=0A}=0A=0A=3Dhead2 num_errors=0A=0A    $num_errors =3D $v->num_errors();=0A=
=0AReturns the number of errors that the validator encountered.=0A=0A=3Dcut=
=0A=0Asub num_errors {=0A    my $self =3D shift;=0A    my $num_errors =3D s=
hift;=0A    return $self->_accessor('num_errors', $num_errors);=0A}=0A=0A=
=3Dhead2 errors=0A=0A    $errors =3D $v->errors();=0A    =0A    foreach my =
$err ( @$errors ) {=0A        printf("line: %s, col: %s\n\terror: %s\n", =
=0A                $err->{line}, $err->{col}, $err->{msg});=0A    }=0A=0ARe=
turns an array ref of hash refs containing information about each error=0Ae=
ncountered.=0A=0ANote that you need XML::XPath for this to work.=0A=0A=3Dcu=
t=0A=0Asub errors {=0A    my $self =3D shift;=0A=0A    return undef unless =
$self->num_errors();=0A=0A    my @errs;=0A    =0A    eval {=0A        requi=
re XML::XPath;=0A    };=0A    if ($@) {=0A        warn "XML::XPath must be =
installed in order to get detailed errors";=0A        return undef;=0A    }=
 else {=0A        my $xp =3D XML::XPath->new( xml =3D> $self->_content() );=
=0A        my @messages =3D $xp->findnodes('/result/messages/msg');=0A=0A  =
      foreach my $msg ( @messages ) {=0A            my $err =3D {};=0A     =
       $err->{line}  =3D $msg->getAttribute('line');=0A            $err->{c=
ol}  =3D $msg->getAttribute('col');=0A            $err->{msg} =3D $msg->get=
ChildNode(1)->getValue();=0A=0A            push @errs, $err;=0A        }=0A=
=0A        return \@errs;=0A    }=0A}=0A=0A=3Dhead2 validator_error=0A=0A  =
  $error =3D $v->validator_error();=0A=0AReturns a string indicating why va=
lidation may not have occured. This is not=0Athe reason that a webpage was =
invalid. It is the reason that no meaningful =0Ainformation about the attem=
pted validation could be obtained. This is most=0Alikely to be an HTTP erro=
r=0A=0APossible values are:=0A=0A=3Dover 4=0A=0A=3Ditem You need to supply =
a URI to validate=0A=0AYou didn't pass a URI to the validate method=0A=0A=
=3Ditem You need to supply a URI with a schema=0A=0AThe URI you passed to v=
alidate didn't have a schema on the front. The =0AW3C validatory can't hand=
le URIs like www.example.com but instead=0Aneeds URIs of the form http://ww=
w.example.com/.=0A=0A=3Ditem Not a W3C Validator or Bad URI=0A=0AThe URI di=
d not return the headers that WebService::Validator::HTML::W3C =0Arelies on=
 so it is likely that there is not a W3C Validator at that URI. =0AThe othe=
r possibility is that it didn't like the URI you provided. Sadly=0Athe Vali=
dator doesn't give very useful feedback on this at the moment.=0A=0A=3Ditem=
 Could not contact validator=0A=0AWebService::Validator::HTML::W3C could no=
t establish a connection to the URI.=0A=0A=3Dback=0A=0A=3Dcut=0A=0Asub vali=
dator_error {=0A    my $self =3D shift;=0A    my $validator_error =3D shift=
;=0A    return $self->_accessor('validator_error', $validator_error);=0A}=
=0A=0A=3Dhead2 validator_uri=0A=0A    $uri =3D $v->validator_uri();=0A    $=
v->validator_uri('http://validator.w3.org/check');=0A=0AReturns or sets the=
 URI of the validator to use. Please note that you need=0Ato use the full p=
ath to the validator cgi.=0A=0A=3Dcut=0A=0Asub validator_uri {=0A    my $se=
lf =3D shift;=0A    my $validator_uri =3D shift;=0A    return $self->_acces=
sor('validator_uri', $validator_uri);=0A}=0A=0A=3Dhead2 http_timeout=0A=0A =
   $timeout =3D $v->http_timeout();=0A    $v->http_timeout(10);=0A=0AReturn=
s or sets the timeout for the HTTP request.=0A=0A=3Dcut=0A=0Asub http_timeo=
ut {=0A    my $self =3D shift;=0A    my $http_timeout =3D shift;=0A    retu=
rn $self->_accessor('http_timeout', $http_timeout);=0A}=0A=0Asub _http_meth=
od {=0A    my $self =3D shift;=0A    my $http_method =3D shift;=0A    retur=
n $self->_accessor('_http_method', $http_method);=0A}=0A=0Asub _content {=
=0A    my $self =3D shift;=0A    my $content =3D shift;=0A    return $self-=
>_accessor('content', $content);=0A}=0A=0Asub _debug {=0A    my $self =3D s=
hift;=0A    my $debug_level =3D shift;=0A    return $self->_accessor('_debu=
g_level', $debug_level);=0A}=0A=0Asub _accessor {=0A    my $self =3D shift;=
=0A    my ($option, $value) =3D @_;=0A=0A    if (defined $value) {=0A      =
  $self->{$option} =3D $value;=0A    }=0A=0A    return $self->{$option};=0A=
}=0A1;=0A=0A__END__=0A=0A=3Dhead1 OTHER MODULES=0A=0APlease note that there=
 is also an official W3C module that is part of the=0AW3C::LogValidator dis=
tribution. However that module is not very useful outside=0Athe constraints=
 of that package. WebService::Validator::HTML::W3C is meant as a more gener=
al way to access the W3C Validator.=0A=0AHTML::Validator uses ngmls to vali=
date against=0Athe W3Cs DTDs. You have to fetch the relevant DTDs and so on=
.=0A=0AThere is also the HTML::Parser based HTML::Lint which mostly checks =
for =0Aknown tags rather than XML/HTML validty.=0A=0A=3Dhead1 IMPORTANT=0A=
=0AThis module is not in any way associated with the W3C so please do not =
=0Areport any problems with this module to them. Also please remember that=
=0Athe online Validator is a shared resource so do not abuse it. This means=
=0Asleeping between requests. If you want to do a lot of testing against it=
=0Athen please consider downloading and installing the Validator software=
=0Awhich is available from the W3C. Debian testing users will also find tha=
t =0Ait is available via apt-get.=0A=0A=3Dhead1 BUGS=0A=0AWhile the interfa=
ce to the Validator seems to be fairly stable it may be =0Aupdated. I will =
endevour to track any changes with this module so please=0Acheck on CPAN fo=
r new versions. Also note that this module is only =0Agaurunteed to work wi=
th the currently stable version of the validator. It=0Awill most likely wor=
k with any Beta versions but don't rely on it.=0A=0AIf in doubt please try =
and run the test suite before reporting bugs. =0A=0AThat said I'm very happ=
y to hear about bugs. All the more so if they come=0Awith patches ;).=0A=0A=
=3Dhead1 SUPPORT=0A=0Aauthor email.=0A=0A=3Dhead1 AUTHOR=0A=0A	Struan Donal=
d=0A	[email protected]=0A	http://www.exo.org.uk/code/=0A=0A=3Dhead1 COPYRIGHT=
=0A=0ACopyright (C) 2003 Struan Donald. All rights reserved.=0A=0AThis prog=
ram is free software; you can redistribute=0Ait and/or modify it under the =
same terms as Perl itself.=0A=0A=3Dhead1 SEE ALSO=0A=0Aperl(1).=0A=0A=3Dcut=
=0A=0A
--b5gNqxB1S1yM7hjW--