File Coverage

blib/lib/Plack/Middleware/Debug/W3CValidate.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Plack::Middleware::Debug::W3CValidate;

our $VERSION = '0.04';
use 5.008;
use strict;
use warnings;
use parent qw(Plack::Middleware::Debug::Base);

use XML::XPath;
use WebService::Validator::HTML::W3C;
use Plack::Util::Accessor qw(validator_uri);

my $table_template = __PACKAGE__->build_template(<<'TABLETMPL');
% my $errs = shift @_;
 </td>
</tr>

<tr>
<td  class="h" >
<a name="16">16</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     #validation_errors td strong { </td>
</tr>

<tr>
<td  class="h" >
<a name="17">17</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">         color: red; </td>
</tr>

<tr>
<td  class="h" >
<a name="18">18</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     } </td>
</tr>

<tr>
<td  class="h" >
<a name="19">19</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">
 




21




 





 





 





 





 





 



      




22




 





 





 





 





 





 



          




23




 





 





 





 





 





 



             Line 




24




 





 





 





 





 





 



             Column 




25




 





 





 





 





 





 



             Message 




26




 





 





 





 





 





 



             Source 




27




 





 





 





 





 





 



          




28




 





 





 





 





 





 



      




29




 





 





 





 





 





 



      




30




 





 





 





 





 





 



 % my $i = 0; 




31




 





 





 





 





 





 



 % for my $error (@$errs) { 




32




 





 





 





 





 





 



          




33




 





 





 





 





 





 



             <%= $error->{line} %> 




34




 





 





 





 





 





 



             <%= $error->{col} %> 




35




 





 





 





 





 





 



             <%= $error->{msg} %> 




36




 





 





 





 





 





 



             <%= Text::MicroTemplate::encoded_string($error->{source}) %> 




37




 





 





 





 





 





 



          




38




 





 





 





 





 





 



 % } 




39




 





 





 





 





 





 



      




40









% my $i = 0;
% for my $error (@$errs) {






% }


TABLETMPL

sub get_validator {
    my $self = shift @_;
    my %opts = ($self->validator_uri ? (validator_uri=>$self->validator_uri) : ());
    return WebService::Validator::HTML::W3C->new(detailed=>1, %opts);
}

sub flatten_body {
    my ($self, $res) = @_;
    my $body = $res->[2];
    if(ref $body eq 'ARRAY') {
        return join "", @$body;
    } elsif(defined $body) {
        my $slurped;
        while (defined(my $line = $body->getline)) {
            $slurped .= $line if length $line;
        }
        return $slurped;
    }
}

## Until (and if) WebService::Validator::HTML::W3C parses for source
sub parse_for_errors {
    my ($self, $xml) = @_;
    my $xp = XML::XPath->new(xml => $xml);
    my @messages = $xp->findnodes( '/env:Envelope/env:Body/m:markupvalidationresponse/m:errors/m:errorlist/m:error' );

    my @errs;
    foreach my $msg ( @messages ) {
        my $err = {
            line => $xp->find( './m:line', $msg )->get_node(1)->getChildNode(1)->getValue,
            col => $xp->find( './m:col', $msg )->get_node(1)->getChildNode(1)->getValue,
            msg => $xp->find( './m:message', $msg )->get_node(1)->getChildNode(1)->getValue,
            source => $xp->find( './m:source', $msg )->get_node(1)->getChildNode(1)->getValue,
        };
        push @errs, $err;
    }
    return @errs;
}

sub run {
    my($self, $env, $panel) = @_;
    $panel->title("W3C Validation");
    $panel->nav_title("W3C Validation");
    return sub {
        my $res = shift @_;
        my $v = $self->get_validator;
        my $slurped_body = $self->flatten_body($res);
        if($v->validate_markup($slurped_body)) {
            if ( $v->is_valid ) {
                $panel->nav_subtitle("Page validated.");
                $panel->content(sub { "No Errors on Page" });
            } else {
                $panel->nav_subtitle('Not valid. Error Count: '.$v->num_errors);
                my @errs = $self->parse_for_errors($v->_content());
                $panel->content(sub {
                    "Errors".
                    $self->render($table_template, \@errs);
                });
            }
        } else {
            $panel->content(sub {
                $self->render_lines([
                    "Failed to validate the website: ". $v->validator_error,
                ]);
            });
        }
    }
}

1;

=head1 NAME

Plack::Middleware::Debug::W3CValidate - Validate your Response Content

=head2 SYNOPSIS

    use Plack::Builder;

    my $app = ...; ## Build your Plack App

    builder {
        enable 'Debug', panels =>['W3CValidate'];
        $app;
    };

=head1 DESCRIPTION

Adds a debug panel that runs your response body through the W3C validator and
returns a list of errors.

=head1 OPTIONS

This debug panel defines the following options.

=head2 validator_uri

Takes the url of the W3C validator.  Defaults to the common validator, but if
you plan to pound this it would be polite to setup your own and point to that
instead.  Please see L for more.

Since this panel needs to read and submit the response body to a POST service
it will definitely increase the time it takes to load the page.

=head1 SEE ALSO

L

=head1 AUTHOR

John Napiorkowski, C<<  >>

=head1 COPYRIGHT & LICENSE

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut