streaming results from the CPAN

Plack-Middleware-HTMLLint
#!perl -w
use strict;
use Test::More;

use Test::Requires qw/ HTML::Lint::Pluggable /;

use Plack::Builder;
use Plack::Test;
use HTTP::Request;

my $valid_html = q{
<!DOCTYPE html>
<html>
<head><title>hoge</title></head>
<body bgcolor="#000"><header><h1>fuga</h1></header></body>
</html>
};

my $error_html = q{
<!DOCTYPE html>
<html>
<head><title>hoge</title></head>
<body bgcolor="#000"><header><h1>fuga</h1></header><hoge></hoge></body>
</html>
};

my $broken_error_html = q{
<!DOCTYPE html>
<html>
<head><title>hoge</title></head>
<header><h1>fuga</h1></header><hoge></hoge>
</html>
};

my $error_html_res = q{
<!DOCTYPE html>
<html>
<head><title>hoge</title></head>
<body bgcolor="#000"><div style="border: double 3px; background-color: rgba(255, 0, 0, 0.2); margin: 3px; padding: 2px;"><h4 style="color: red">HTML&nbsp;Error</h4><dl><dt style="margin-left: 0.25em">elem-unknown</dt><dd style="padding-top: 0.25em; b...
</html>
};

my $error_html_res_streaming = q{
<!DOCTYPE html>
<html>
<head><title>hoge</title></head>
<body bgcolor="#000"><header><h1>fuga</h1></header><hoge></hoge><div style="border: double 3px; background-color: rgba(255, 0, 0, 0.2); margin: 3px; padding: 2px;"><h4 style="color: red">HTML&nbsp;Error</h4><dl><dt style="margin-left: 0.25em">elem-un...
</html>
};

my $broken_error_html_res = q{
<!DOCTYPE html>
<html>
<head><title>hoge</title></head>
<header><h1>fuga</h1></header><hoge></hoge>
</html>
<div style="border: double 3px; background-color: rgba(255, 0, 0, 0.2); margin: 3px; padding: 2px;"><h4 style="color: red">HTML&nbsp;Error</h4><dl><dt style="margin-left: 0.25em">elem-unknown</dt><dd style="padding-top: 0.25em; border-bottom: 1px sol...
};
chomp $broken_error_html_res;

my $normal_handler = builder {
    enable 'HTMLLint::Pluggable', plugins => +{ html5 => [qw/HTML5/] };
    mount '/text' => sub {
        return [200, ['Content-Type' => 'text/plain'], [ 'OK' ]];
    };
    mount '/valid_html' => sub {
        return [200, ['Content-Type' => 'text/html'], [$valid_html]];
    };
    mount '/error_html' => sub {
        return [200, ['Content-Type' => 'text/html'], [$error_html]];
    };
    mount '/broken_error_html' => sub {
        return [200, ['Content-Type' => 'text/html'], [$broken_error_html]];
    };
};

my $streaming_handler = builder {
    enable 'HTMLLint::Pluggable', plugins => +{ html5 => [qw/HTML5/] };
    mount '/text' => sub {
        return sub {
            my $responder = shift;
            my $writer = $responder->([200, ['Content-Type' => 'text/plain']]);
            $writer->write("OK");
            $writer->close;
        };
    };
    mount '/valid_html' => sub {
        return sub {
            my $responder = shift;
            my $writer = $responder->([200, ['Content-Type' => 'text/html']]);
            foreach my $line (split /\n/, $valid_html) {
                $writer->write($line);
                $writer->write("\n");
            }
            $writer->close;
        };
    };
    mount '/error_html' => sub {
        return sub {
            my $responder = shift;
            my $writer = $responder->([200, ['Content-Type' => 'text/html']]);
            foreach my $line (split /\n/, $error_html) {
                $writer->write($line);
                $writer->write("\n");
            }
            $writer->close;
        };
    };
    mount '/broken_error_html' => sub {
        return sub {
            my $responder = shift;
            my $writer = $responder->([200, ['Content-Type' => 'text/html']]);
            foreach my $line (split /\n/, $broken_error_html) {
                $writer->write($line);
                $writer->write("\n");
            }
            $writer->close;
        };
    };
};

subtest 'normal' => sub {
    test_psgi(
        client => sub {
            my $cb = shift;
            my $res;

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/text') );
            is $res->content, 'OK', 'plain text is not modified.';

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/valid_html') );
            is $res->content, $valid_html, 'valid html is not modified.';

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/error_html') );
            isnt $res->content, $error_html, 'error html is modified.';
            is $res->content,   $error_html_res, 'error html has error message.';

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/broken_error_html') );
            isnt $res->content, $broken_error_html, 'broken error html is modified.';
            is $res->content,   $broken_error_html_res, 'broken error html has error message.';
        },
        app    => $normal_handler,
    );
};

subtest 'streaming' => sub {
    test_psgi(
        client => sub {
            my $cb = shift;
            my $res;

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/text') );
            is $res->content, 'OK', 'plain text is not modified.';

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/valid_html') );
            is $res->content, $valid_html, 'valid html is not modified.';

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/error_html') );
            isnt $res->content, $error_html, 'error html is modified.';
            is $res->content,   $error_html_res_streaming, 'error html has error message.';

            $res = $cb->( HTTP::Request->new(GET => 'http://example.com/broken_error_html') );
            isnt $res->content, $broken_error_html, 'broken error html is modified.';
            is $res->content,   $broken_error_html_res, 'broken error html has error message.';
        },
        app    => $streaming_handler,
    );
};

done_testing;
( run in 0.888 second using v1.01-cache-2.11-cpan-39bf76dae61 )