- From: Olivier Thereaux via cvs-syncmail <cvsmail@w3.org>
- Date: Mon, 31 Oct 2005 07:46:51 +0000
- To: www-validator-cvs@w3.org
Update of /sources/public/perl/modules/WebService/Validator/CSS/lib/WebService/Validator/CSS In directory hutz:/tmp/cvs-serv16086 Modified Files: W3C.pm Log Message: Adding warningcount and errorcount methods. Also made the line endings more unix-ish, which may confuse the diff tool... Index: W3C.pm =================================================================== RCS file: /sources/public/perl/modules/WebService/Validator/CSS/lib/WebService/Validator/CSS/W3C.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- W3C.pm 20 Oct 2005 05:54:30 -0000 1.5 +++ W3C.pm 31 Oct 2005 07:46:48 -0000 1.6 @@ -1,402 +1,429 @@ -package WebService::Validator::CSS::W3C; -use strict; -use warnings; - -use SOAP::Lite; -use LWP::UserAgent qw//; -use URI qw//; -use URI::QueryParam qw//; -use Carp qw//; -use base qw/Class::Accessor/; - -our $VERSION = "0.02"; - -# profiles currently supported by the W3C CSS Validator -our %PROFILES = map { $_ => 1 } qw/none css1 css2 css21 css3 svg svgbasic - svgtiny mobile atsc-tv tv/; - -# user media currently supported by the W3C CSS Validator -our %MEDIA = map { $_ => 1 } qw/all aural braille embossed handheld - print screen tty tv presentation/; - -# warnings level currently supported by the W3C CSS Validator -our $WARNINGS = map { $_ => 1 } qw/0 1 2 no/; - -__PACKAGE__->mk_accessors qw/user_agent validator_uri/; -__PACKAGE__->mk_ro_accessors qw/response request_uri som success/; - -sub new -{ - my $proto = shift; - my $class = ref $proto || $proto; - my $self = bless {}, $class; - my $ua = shift; - my $uri = shift; - - if (defined $ua) { - - # check whether it really is - Carp::croak "$ua is not a LWP::UserAgent" - unless UNIVERSAL::isa($ua, 'LWP::UserAgent'); - - $self->user_agent($ua); - } else { - my $ua = LWP::UserAgent->new(agent => __PACKAGE__."/".$VERSION); - $self->user_agent($ua); - } - - if (defined $uri) { - $self->validator_uri($uri); - } else { - $self->validator_uri("http://jigsaw.w3.org/css-validator/validator"); - } - - return $self; -} - -sub _handle_response -{ - my $self = shift; - my $res = shift; - - # internal or server errors... - return 0 unless $res->is_success; - - local $_ = $res->content; - - - # workaround for SOAP::Lite's lack of support for SOAP 1.2 - s{xmlns:env="http://www.w3.org/2003/05/soap-envelope"} - {xmlns:env="http://www.w3.org/2001/06/soap-envelope"}; - - # workaround for SOAP::Lite's lack of support for SOAP 1.2 - s{env:encodingStyle="http://www.w3.org/2003/05/soap-encoding"} - {env:encodingStyle="http://www.w3.org/2001/06/soap-encoding"}; - - my $som; - eval { $som = SOAP::Deserializer->new->deserialize($_); }; - - # Deserialization might fail if the response is not a legal - # SOAP response, e.g., if the response is ill-formed... Not - # sure how to make the reason for failure available to the - # application, suggestions welcome. - if ($@) { - # Carp::carp $@; - return 0; - } - - # memorize the SOAP object model object - $self->{'som'} = $som; - - # check whether this is really the CSS Validator responding - if ($som->match("/Envelope/Body/cssvalidationresponse")) { - $self->{'success'} = 1; +package WebService::Validator::CSS::W3C; +use strict; +use warnings; + +use SOAP::Lite; +use LWP::UserAgent qw//; +use URI qw//; +use URI::QueryParam qw//; +use Carp qw//; +use base qw/Class::Accessor/; + +our $VERSION = "0.02"; + +# profiles currently supported by the W3C CSS Validator +our %PROFILES = map { $_ => 1 } qw/none css1 css2 css21 css3 svg svgbasic + svgtiny mobile atsc-tv tv/; + +# user media currently supported by the W3C CSS Validator +our %MEDIA = map { $_ => 1 } qw/all aural braille embossed handheld + print screen tty tv presentation/; + +# warnings level currently supported by the W3C CSS Validator +our $WARNINGS = map { $_ => 1 } qw/0 1 2 no/; + +__PACKAGE__->mk_accessors qw/user_agent validator_uri/; +__PACKAGE__->mk_ro_accessors qw/response request_uri som success/; + +sub new +{ + my $proto = shift; + my $class = ref $proto || $proto; + my $self = bless {}, $class; + my $ua = shift; + my $uri = shift; + + if (defined $ua) { + + # check whether it really is + Carp::croak "$ua is not a LWP::UserAgent" + unless UNIVERSAL::isa($ua, 'LWP::UserAgent'); + + $self->user_agent($ua); + } else { + my $ua = LWP::UserAgent->new(agent => __PACKAGE__."/".$VERSION); + $self->user_agent($ua); } - # if the response was a SOAP fault + + if (defined $uri) { + $self->validator_uri($uri); + } else { + $self->validator_uri("http://jigsaw.w3.org/css-validator/validator"); + } + + return $self; +} + +sub _handle_response +{ + my $self = shift; + my $res = shift; + + # internal or server errors... + return 0 unless $res->is_success; + + local $_ = $res->content; + + + # workaround for SOAP::Lite's lack of support for SOAP 1.2 + s{xmlns:env="http://www.w3.org/2003/05/soap-envelope"} + {xmlns:env="http://www.w3.org/2001/06/soap-envelope"}; + + # workaround for SOAP::Lite's lack of support for SOAP 1.2 + s{env:encodingStyle="http://www.w3.org/2003/05/soap-encoding"} + {env:encodingStyle="http://www.w3.org/2001/06/soap-encoding"}; + + my $som; + eval { $som = SOAP::Deserializer->new->deserialize($_); }; + + # Deserialization might fail if the response is not a legal + # SOAP response, e.g., if the response is ill-formed... Not + # sure how to make the reason for failure available to the + # application, suggestions welcome. + if ($@) { + # Carp::carp $@; + return 0; + } + + # memorize the SOAP object model object + $self->{'som'} = $som; + + # check whether this is really the CSS Validator responding + if ($som->match("/Envelope/Body/cssvalidationresponse")) { + $self->{'success'} = 1; + } + # if the response was a SOAP fault elsif ($som->match("/Envelope/Body/Fault")) { $self->{'success'} = 0; } - - # return whether the response was successfully processed - return $self->{'success'}; -} - -sub validate -{ - my $self = shift; - my %parm = @_; - my $uri = URI->new($self->validator_uri); - my $ua = $self->user_agent; - - $self->{'success'} = 0; - - # - if (defined $parm{string}) { - $uri->query_param(text => $parm{string}); - } elsif (defined $parm{uri}) { - $uri->query_param(uri => $parm{uri}); - } else { - Carp::croak "you must supply a string/uri parameter\n"; - } - - if (defined $parm{medium}) { - # check whether the medium is supported - Carp::croak "$parm{medium} is not a legal medium\n" - unless $MEDIA{$parm{medium}}; - - $uri->query_param(medium => $parm{medium}); - } - - if (defined $parm{profile}) { - # check whether the profile is supported - Carp::croak "$parm{profile} is not a legal profile\n" - unless $PROFILES{$parm{profile}}; - - $uri->query_param(profile => $parm{profile}); - } - - if (defined $parm{warnings}) { - Carp::croak "warnings must be an integer 0 - 10\n" - unless $parm{warnings} =~ /^[0-9]|10$/; - - if ($parm{warnings} == 0) { - $uri->query_param(warning => "no"); - } - else { - $uri->query_param(warning => $parm{warnings}); - } - } - - # request SOAP 1.2 output - $uri->query_param(output => "soap12"); - - # memorize request uri - $self->{'request_uri'} = $uri; - - # generate new HTTP::Request object - my $req = HTTP::Request->new(GET => $uri); - - # add an Accept-Language header if desired - if (defined $parm{language}) { - $req->header(Accept_Language => $parm{language}); - } - - my $res = $ua->simple_request($req); - - # memorize response - $self->{'response'} = $res; - - return $self->_handle_response($res); -} - -sub is_valid -{ - my $self = shift; - my $som = $self->som; - - # previous failure means the style sheet is invalid - return 0 unless $self->success and defined $som; - - # fetch validity field in reponse - my $validity = $som->valueof("/Envelope/Body/cssvalidationresponse/validity"); - - # valid if m:validity is true - return 1 if defined $validity and $validity eq "true"; - - # else invalid - return 0; -} - -sub errors -{ - my $self = shift; - my $som = $self->som; - - return () unless defined $som; - return $som->valueof("//error"); -} - -sub warnings -{ - my $self = shift; - my $som = $self->som; - - return () unless defined $som; - return $som->valueof("//warning"); -} - - -1; - -__END__ - -=pod - -=head1 NAME - -WebService::Validator::CSS::W3C - Interface to the W3C CSS Validator - -=head1 SYNOPSIS - - use WebService::Validator::CSS::W3C; - - my $css = "p { color: not-a-color }"; - my $val = WebService::Validator::CSS::W3C->new; - my $ok = $val->validate(string => $css); - - if ($ok and !$val->is_valid) { - print "Errors:\n"; - printf " * %s\n", $_->{message} - foreach $val->errors - } - -=head1 DESCRIPTION - + + # return whether the response was successfully processed + return $self->{'success'}; +} + +sub validate +{ + my $self = shift; + my %parm = @_; + my $uri = URI->new($self->validator_uri); + my $ua = $self->user_agent; + + $self->{'success'} = 0; + + # + if (defined $parm{string}) { + $uri->query_param(text => $parm{string}); + } elsif (defined $parm{uri}) { + $uri->query_param(uri => $parm{uri}); + } else { + Carp::croak "you must supply a string/uri parameter\n"; + } + + if (defined $parm{medium}) { + # check whether the medium is supported + Carp::croak "$parm{medium} is not a legal medium\n" + unless $MEDIA{$parm{medium}}; + + $uri->query_param(medium => $parm{medium}); + } + + if (defined $parm{profile}) { + # check whether the profile is supported + Carp::croak "$parm{profile} is not a legal profile\n" + unless $PROFILES{$parm{profile}}; + + $uri->query_param(profile => $parm{profile}); + } + + if (defined $parm{warnings}) { + Carp::croak "warnings must be an integer 0 - 10\n" + unless $parm{warnings} =~ /^[0-9]|10$/; + + if ($parm{warnings} == 0) { + $uri->query_param(warning => "no"); + } + else { + $uri->query_param(warning => $parm{warnings}); + } + } + + # request SOAP 1.2 output + $uri->query_param(output => "soap12"); + + # memorize request uri + $self->{'request_uri'} = $uri; + + # generate new HTTP::Request object + my $req = HTTP::Request->new(GET => $uri); + + # add an Accept-Language header if desired + if (defined $parm{language}) { + $req->header(Accept_Language => $parm{language}); + } + + my $res = $ua->simple_request($req); + + # memorize response + $self->{'response'} = $res; + + return $self->_handle_response($res); +} + +sub is_valid +{ + my $self = shift; + my $som = $self->som; + + # previous failure means the style sheet is invalid + return 0 unless $self->success and defined $som; + + # fetch validity field in reponse + my $validity = $som->valueof("/Envelope/Body/cssvalidationresponse/validity"); + + # valid if m:validity is true + return 1 if defined $validity and $validity eq "true"; + + # else invalid + return 0; +} + +sub errors +{ + my $self = shift; + my $som = $self->som; + + return () unless defined $som; + return $som->valueof("//error"); +} + +sub warnings +{ + my $self = shift; + my $som = $self->som; + + return () unless defined $som; + return $som->valueof("//warning"); +} + +sub errorcount +{ + my $self = shift; + my $som = $self->som; + + return () unless defined $som; + return $som->valueof("//errorcount"); +} + +sub warningcount +{ + my $self = shift; + my $som = $self->som; + + return () unless defined $som; + return $som->valueof("//warningcount"); +} + +1; + +__END__ + +=pod + +=head1 NAME + +WebService::Validator::CSS::W3C - Interface to the W3C CSS Validator + +=head1 SYNOPSIS + + use WebService::Validator::CSS::W3C; + + my $css = "p { color: not-a-color }"; + my $val = WebService::Validator::CSS::W3C->new; + my $ok = $val->validate(string => $css); + + if ($ok and !$val->is_valid) { + print "Errors:\n"; + printf " * %s\n", $_->{message} + foreach $val->errors + } + +=head1 DESCRIPTION + This module is an interface to the W3C CSS Validation online service L<http://jigsaw.w3.org/css-validator/>, based on its SOAP 1.2 support. -It helps to find errors in Cascading Style Sheets. - -The following methods are available: - -=over 4 - -=item my $val = WebService::Validator::CSS::W3C->new - -=item my $val = WebService::Validator::CSS::W3C->new($ua) - -=item my $val = WebService::Validator::CSS::W3C->new($ua, $url) - -Creates a new WebService::Validator::CSS::W3C object. A custom -L<LWP::UserAgent> object can be supplied which is then used for HTTP -communication with the CSS Validator. $url is the URL of the CSS -Validator, C<http://jigsaw.w3.org/css-validator/validator> by default. - -=item my $success = $val->validate(%params) - -Validate a style sheet, takes C<%params> as defined below. Either C<string> -or C<uri> must be supplied. Returns a true value if the validation succeeded -(regardless of whether the style sheet contains errors). - -=over 4 - -=item string => $css - -A style sheet as a string. It is currently unlikely that validation will work -if the string is not a legal UTF-8 string. If a string is specified, the C<uri> -parameter will be ignored. Note that C<GET> will be used to pass the string -to the Validator, it might not work with overly long strings. - -=item uri => $uri - -The location of a style sheet or a HTML/XHTML/SVG document containing or -referencing style sheets. - -=item medium => "print" - -The medium for which the style sheet should apply, one of C<aural>, C<braille>, -C<embossed>, C<handheld>, C<print>, C<screen>, C<tty>, C<tv>, and C<presentation>. -A special value C<all> can also be specified. The default is C<undef> in which -case the CSS Validator determines a value; this would currently be as if C<all> -had been specified. - -=item profile => "css3" - -The CSS Version or profile to validate against, legal values are C<css1>, C<css2>, C<css21>, -C<css3>, C<svg>, C<svgbasic>, C<svgtiny>, C<mobile>, C<atsc-tv>, and C<tv>. A special -value C<none> can also be used. The default is C<undef> in which case the CSS Validator -determines a default. This would currently behave as if C<css2> had been specified. - -=item warnings => 2 - -An integer C<0> - C<10> that determines how many warning messages you want to get -back from the CSS Validator, C<0> means no warnings, C<10> would give most warnings, -but is currently effectively the same as C<1>. The defaut is C<undef> in which case -the CSS Validator determines a default value; this is expected to be as if C<2> had -been specified. - -=item language => "de" - -The desired language of the supposedly human-readable messages. The string will -passed as an C<Accept-Language> header in the HTTP request. The CSS Validator -currently supports C<en>, C<de>, C<fr>, C<ja>, C<nl>, C<zh>, and C<zh-cn>. - -=back - -=item my $success = $val->success - -Same as the return value of C<validate()>. - -=item my $is_valid = $val->is_valid - -Returns a true value if the last attempt to C<validate()> succeeded and the -validator reported no errors in the style sheet. - -=item my @errors = $val->errors - -Returns a list with information about the errors found for the -style sheet. An error is a hash reference; the example in the -synopsis would currently return something like - - ( { - context => 'p', - property => 'color', - expression => { start => '', end => 'not-a-color' } - errortype => 'parse-error', - message => 'not-a-color is not a color value', - line => 0, - } ) - - -=item my @warnings = $val->warnings - -Returns a list with information about the warnings found for the -style sheet. This is currently of limited use as it is broken, see -L<http://www.w3.org/Bugs/Public/show_bug.cgi?id=771> for details. - -@@example - -=item my $ua = $val->user_agent - -=item my $ua = $val->user_agent($new_ua) - -The L<LWP::UserAgent> object you supplied to the constructor or a -custom object created at construction time you can manipulate. - - # set timeout to 30 seconds - $val->user_agent->timeout(30); - -You can also supply a new object to replace the old one. - -=item my $uri = $val->validator_uri - -=item my $uri = $val->validator_uri($validator_uri) - -Gets or sets the URI of the validator. If you did not specify a -custom URI, C<http://jigsaw.w3.org/css-validator/validator> by -default. - -=item my $response = $val->response - -The L<HTTP::Response> object returned from the last request. This is -useful to determine why validation might have failed. - - if (!$val->validate(string => $css)) { - if (!$val->response->is_success) { - print $val->response->message, "\n" - } - } - -=item my $uri = $val->request_uri - -The L<URI> object used for the last request. - -=item my $som = $val->som - -The L<SOAP::SOM> object for the last successful deserialization, check the -return value of C<validate()> or C<success()> before using the object. - -=back - -=head1 BUGS - +It helps to find errors in Cascading Style Sheets. + +The following methods are available: + +=over 4 + +=item my $val = WebService::Validator::CSS::W3C->new + +=item my $val = WebService::Validator::CSS::W3C->new($ua) + +=item my $val = WebService::Validator::CSS::W3C->new($ua, $url) + +Creates a new WebService::Validator::CSS::W3C object. A custom +L<LWP::UserAgent> object can be supplied which is then used for HTTP +communication with the CSS Validator. $url is the URL of the CSS +Validator, C<http://jigsaw.w3.org/css-validator/validator> by default. + +=item my $success = $val->validate(%params) + +Validate a style sheet, takes C<%params> as defined below. Either C<string> +or C<uri> must be supplied. Returns a true value if the validation succeeded +(regardless of whether the style sheet contains errors). + +=over 4 + +=item string => $css + +A style sheet as a string. It is currently unlikely that validation will work +if the string is not a legal UTF-8 string. If a string is specified, the C<uri> +parameter will be ignored. Note that C<GET> will be used to pass the string +to the Validator, it might not work with overly long strings. + +=item uri => $uri + +The location of a style sheet or a HTML/XHTML/SVG document containing or +referencing style sheets. + +=item medium => "print" + +The medium for which the style sheet should apply, one of C<aural>, C<braille>, +C<embossed>, C<handheld>, C<print>, C<screen>, C<tty>, C<tv>, and C<presentation>. +A special value C<all> can also be specified. The default is C<undef> in which +case the CSS Validator determines a value; this would currently be as if C<all> +had been specified. + +=item profile => "css3" + +The CSS Version or profile to validate against, legal values are C<css1>, C<css2>, C<css21>, +C<css3>, C<svg>, C<svgbasic>, C<svgtiny>, C<mobile>, C<atsc-tv>, and C<tv>. A special +value C<none> can also be used. The default is C<undef> in which case the CSS Validator +determines a default. This would currently behave as if C<css2> had been specified. + +=item warnings => 2 + +An integer C<0> - C<10> that determines how many warning messages you want to get +back from the CSS Validator, C<0> means no warnings, C<10> would give most warnings, +but is currently effectively the same as C<1>. The defaut is C<undef> in which case +the CSS Validator determines a default value; this is expected to be as if C<2> had +been specified. + +=item language => "de" + +The desired language of the supposedly human-readable messages. The string will +passed as an C<Accept-Language> header in the HTTP request. The CSS Validator +currently supports C<en>, C<de>, C<fr>, C<ja>, C<nl>, C<zh>, and C<zh-cn>. + +=back + +=item my $success = $val->success + +Same as the return value of C<validate()>. + +=item my $is_valid = $val->is_valid + +Returns a true value if the last attempt to C<validate()> succeeded and the +validator reported no errors in the style sheet. + +=item my $num_errors = $val->errorcount + +returns the number of errors found for the checked style sheet. +Get the details of the errors with $val->errors (see below). + +=item my @errors = $val->errors + +Returns a list with information about the errors found for the +style sheet. An error is a hash reference; the example in the +synopsis would currently return something like + + ( { + context => 'p', + property => 'color', + expression => { start => '', end => 'not-a-color' } + errortype => 'parse-error', + message => 'not-a-color is not a color value', + line => 0, + } ) + +=item my $num_warnings = $val->warningcount + +returns the number of warnings found for the checked style sheet. +Get the details of each warning with $val->warnings (see below). + + +=item my @warnings = $val->warnings + +Returns a list with information about the warnings found for the +style sheet. This is currently of limited use as it is broken, see +L<http://www.w3.org/Bugs/Public/show_bug.cgi?id=771> for details. + +@@example + +=item my $ua = $val->user_agent + +=item my $ua = $val->user_agent($new_ua) + +The L<LWP::UserAgent> object you supplied to the constructor or a +custom object created at construction time you can manipulate. + + # set timeout to 30 seconds + $val->user_agent->timeout(30); + +You can also supply a new object to replace the old one. + +=item my $uri = $val->validator_uri + +=item my $uri = $val->validator_uri($validator_uri) + +Gets or sets the URI of the validator. If you did not specify a +custom URI, C<http://jigsaw.w3.org/css-validator/validator> by +default. + +=item my $response = $val->response + +The L<HTTP::Response> object returned from the last request. This is +useful to determine why validation might have failed. + + if (!$val->validate(string => $css)) { + if (!$val->response->is_success) { + print $val->response->message, "\n" + } + } + +=item my $uri = $val->request_uri + +The L<URI> object used for the last request. + +=item my $som = $val->som + +The L<SOAP::SOM> object for the last successful deserialization, check the +return value of C<validate()> or C<success()> before using the object. + +=back + +=head1 BUGS + This module uses the SOAP interface for the W3C CSS validatom, which still -has a number of bugs, tracked via W3C's Bugzilla, L<http://www.w3.org/Bugs/Public/>. - -Please report bugs in the W3C CSS Validator to L<www-validator-css@w3.org> or -enter them directly in Bugzilla (see above). Please report bugs in this module -via RT, L<http://rt.cpan.org/>. - -=head1 NOTE - -This module is not directly associated with the W3C. Please remember -that the CSS Validator is a shared resource so do not abuse it: you should -sleep between requests, and consider installing the Validator locally, see -L<http://jigsaw.w3.org/css-validator/DOWNLOAD.html>. - -=head1 AUTHOR - -Bjoern Hoehrmann <bjoern@hoehrmann.de> - -This module is licensed under the same terms as Perl itself. - -=cut +has a number of bugs, tracked via W3C's Bugzilla, L<http://www.w3.org/Bugs/Public/>. + +Please report bugs in the W3C CSS Validator to L<www-validator-css@w3.org> or +enter them directly in Bugzilla (see above). Please report bugs in this module +via RT, L<http://rt.cpan.org/>. + +=head1 NOTE + +This module is not directly associated with the W3C. Please remember +that the CSS Validator is a shared resource so do not abuse it: you should +sleep between requests, and consider installing the Validator locally, see +L<http://jigsaw.w3.org/css-validator/DOWNLOAD.html>. + +=head1 AUTHOR + +Bjoern Hoehrmann <bjoern@hoehrmann.de> + +This module is licensed under the same terms as Perl itself. + +=cut
Received on Monday, 31 October 2005 07:46:56 UTC