File Coverage

blib/lib/Plack/Middleware/HTMLLint.pm

Criterion	Covered	Total	%
statement	89	90	98.8
branch	22	26	84.6
condition	4	5	80.0
subroutine	15	15	100.0
pod	2	3	66.6
total	132	139	94.9

package Plack::Middleware::HTMLLint;
use 5.008_001;
use strict;
use warnings;

our $VERSION = '0.02';

use parent qw/ Plack::Middleware /;

use constant +{
    PSGI_STATUS  => 0,
    PSGI_HEADER  => 1,
    PSGI_BODY    => 2,
};

use constant +{
    SYNTAX_HTML5 => 'html5',
    SYNTAX_HTML4 => 'html4',
    SYNTAX_XHTML => 'xhtml',
};

use Plack::Util;
use Plack::Util::Accessor qw/error2html/;
use HTML::Lint;
use HTML::Escape qw/escape_html/;

sub prepare_app {
    my $self = shift;
    unless ($self->error2html) {
        $self->error2html(sub {
            my @errors = @_;

            my @error_html;
            push @error_html => '';
            push @error_html => 'HTML Error';
            push @error_html => '';
            foreach my $error (@errors) {
                push @error_html => '', escape_html($error->errcode), '';
                push @error_html => '', escape_html($error->as_string), '';
            }
            push @error_html => '';

            push @error_html => '';

            return join '', @error_html;
        });
    }
}

sub call {
    my($self, $env) = @_;

    return $self->response_cb($self->app->($env), sub {
        my $res = shift;
        my $content_type = Plack::Util::header_get($res->[PSGI_HEADER], 'Content-Type') || '';

        if ($content_type =~ m{^(?:text/x?html|application/xhtml\+xml)\b}io) {# HTML/XHTML
            my $do_lint = sub {
                my $content = shift;

                my $syntax = ($content =~ /^$/imo)                             ? SYNTAX_HTML5:
                             ($content_type =~ m{^(?:text/xhtml|application/xhtml\+xml)\b}io) ? SYNTAX_XHTML:
                             SYNTAX_HTML4;

                if (my @errors = $self->html_lint($syntax => $content)) {
                    return $self->error2html->(@errors);
                }
                else {
                    return '';
                }
            };

            if ($res->[PSGI_BODY]) {
                my $content = '';
                Plack::Util::foreach($res->[PSGI_BODY] => sub { $content .= $_[0] });
                if (my $error_html = $do_lint->($content)) {
                    unless ($content =~ s{]*)>}{$error_html}i) {
                        ## fallback
                        $content .= $error_html;
                    }
                    $res->[PSGI_BODY] = [$content];
                }
            }
            else {
                # XXX: It has become increasingly complex not to block the stream as possible.
                my $buffer           = '';
                my $html_last_buffer = '';
                my $end_of_html_body = 0;
                my $do_lint_finished = 0;
                return sub {
                    my $body_chunk = shift;
                    if (defined $body_chunk) {
                        $buffer .= $body_chunk;
                        if ($end_of_html_body || $body_chunk =~ m{}io) {
                            $end_of_html_body = 1;
                            $html_last_buffer .= $body_chunk;
                            return '';
                        }
                        else {
                            return $body_chunk;
                        }
                    }
                    else {
                        if ($do_lint_finished) {
                            return;
                        }
                        else {
                            my $error_html = $do_lint->($buffer);
                            if ($error_html) {
                                unless ($html_last_buffer =~ s{}{$error_html}i) {
                                    ## fallback
                                    $html_last_buffer = $error_html . $html_last_buffer;
                                }
                            }

                            $do_lint_finished = 1;
                            return $html_last_buffer;
                        }
                    }
                };
            }
        }

        return;
    });
}

sub html_lint {
    my($self, $syntax, $content) = @_;

    my $lint = HTML::Lint->new;
    $lint->parse($content);
    $lint->eof;

    return $lint->errors;
}

1;
__END__