The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use warnings;
use strict;
use Test::More tests => 143;
use utf8;
use Test::Fatal;
use lib 't'; use Utils;

BEGIN { use_ok('Feersum') };

my ($socket, $port) = get_listen_socket();
ok $socket, "made listen socket";
ok $socket->fileno, "has a fileno";

my $evh = Feersum->new();

{
    no warnings 'redefine';
    *Feersum::DIED = sub {
        my $err = shift;
        warn "Died during request handler: $err";
    };
}

$evh->request_handler(sub {
    local $@;
    my $r = shift;
    isa_ok $r, 'Feersum::Connection', 'connection';
    my $env;
    is exception { $env = $r->env() }, undef, 'obtain env';
    ok $env && ref($env) eq 'HASH', "env hash";

    my $tn = $env->{HTTP_X_TEST_NUM} || 0;
    ok $tn, "got a test number header $tn";

    is_deeply $env->{'psgi.version'}, [1,1], 'got psgi.version';
    is $env->{'psgi.url_scheme'}, "http", 'got psgi.url_scheme';
    ok exists $env->{'psgi.run_once'}, 'got psgi.run_once';
    ok $env->{'psgi.nonblocking'}, 'got psgi.nonblocking';
    is $env->{'psgi.multithread'}, '', 'got psgi.multithread';
    is $env->{'psgi.multiprocess'}, '', 'got psgi.multiprocess';
    ok $env->{'psgix.body.scalar_refs'}, 'Feersum supports scalar-refs in the body part of the response (psgix.body.scalar_refs)';

    my $errfh = $env->{'psgi.errors'};
    ok $errfh, 'got psgi.errors';
    is exception { $errfh->print() }, undef, "errors fh can print()";

    is $env->{REQUEST_METHOD}, ($tn == 5 ? 'POST' : 'GET'), "got req method";
    like $env->{HTTP_USER_AGENT}, qr/FeersumSimpleClient/, "got UA";

    ok !exists $env->{HTTP_CONTENT_LENGTH}, "C-L is a promoted header";
    ok !exists $env->{HTTP_CONTENT_TYPE}, "C-T is a promoted header";

    if ($tn == 1) {
        is $env->{CONTENT_LENGTH}, 0, "got zero C-L";
        like $env->{HTTP_REFERER}, qr/wrong/, "got the Referer";
        is $env->{QUERY_STRING}, 'blar', "got query string";
        is $env->{PATH_INFO}, '/what is wrong?', "got decoded path info string";
        is $env->{REQUEST_URI}, '/what%20is%20wrong%3f?blar', "got full URI string";
    }
    elsif ($tn == 2) {
        is $env->{CONTENT_LENGTH}, 0, "got zero C-L";
        like $env->{HTTP_REFERER}, qr/good/, "got a Referer";
        is $env->{QUERY_STRING}, 'dlux=sonice', "got query string";
        is $env->{PATH_INFO}, '/what% is good?%2', "got decoded path info string";
        is $env->{REQUEST_URI}, '/what%%20is%20good%3F%2?dlux=sonice', "got full URI string";
    }
    elsif ($tn == 3) {
        is $env->{CONTENT_LENGTH}, 0, "got zero C-L";
        like $env->{HTTP_REFERER}, qr/ugly/, "got a Referer";
        is $env->{QUERY_STRING}, '', "got query string";
        is $env->{PATH_INFO}, '/no query', "got decoded path info string";
        is $env->{REQUEST_URI}, '/no%20query', "got full URI string";
    }
    elsif ($tn == 4) {
        is $env->{CONTENT_LENGTH}, 0, "got zero C-L";
    }
    elsif ($tn == 5) {
        is $env->{CONTENT_LENGTH}, 9, "got zero C-L";
        is $env->{CONTENT_TYPE}, 'text/plain; charset=US-ASCII',
            "C-T is a promoted header";
    }

    is $env->{SERVER_NAME}, '127.0.0.1', "got server name";
    is $env->{SERVER_PORT}, $port, "got server port";
    ok $env->{REMOTE_ADDR}, "remote addr";
    ok $env->{REMOTE_PORT}, "remote port";

    ok !exists $env->{HTTP_ACCEPT_CHARSET},
        "spot check that a placeholder Accept-Charset isn't there";
    ok !exists $env->{HTTP_ACCEPT_LANGUAGE},
        "spot check that a placeholder Accept-Language isn't there";

    is exception {
        $r->send_response("200 OK", [
            'Content-Type' => 'text/plain; charset=UTF-8',
            'Connection' => 'close',
        ], ["Oh Hai $env->{HTTP_X_TEST_NUM}\n"]);
    }, undef, 'sent response';
});

is exception {
    $evh->use_socket($socket);
}, undef, 'assigned socket';

my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => "/what%20is%20wrong%3f?blar",
    headers => {'x-test-num' => 1, 'Referer' => '/wrong'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 1 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 1 content-length was calculated correctly';

    is $body, "Oh Hai 1\n", 'client 1 expected body';
    $cv->end;
};

$cv->begin;
my $w2 = simple_client GET => "/what%%20is%20good%3F%2?dlux=sonice", 
    headers => {'x-test-num' => 2, 'Referer' => 'good'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 2 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 2 content-length was calculated correctly';

    is $body, "Oh Hai 2\n", 'client 2 expected body';
    $cv->end;
};

$cv->begin;
my $w3 = simple_client GET => "/no%20query",
    headers => {'x-test-num' => 3, 'Referer' => 'ugly'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 3 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 3 content-length was calculated correctly';

    is $body, "Oh Hai 3\n", 'client 3 expected body';
    $cv->end;
};

$cv->begin;
my $w4 = simple_client GET => "/no spaces allowed",
    headers => {'x-test-num' => 4, 'Referer' => 'ugly'},
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 400, 'client 4 Bad Request';
    is $headers->{Reason}, "Bad Request";
    is $headers->{'content-type'}, 'text/plain';
    is $body, "Malformed request.\n", 'client 4 expected error';
    $cv->end;
};

$cv->begin;
my $w5 = simple_client POST => "/post",
    headers => {
        'x-test-num' => 5,
        'Content-Type' => 'text/plain; charset=US-ASCII',
    },
    body => "The post\n",
    timeout => 3,
sub {
    my ($body, $headers) = @_;
    is $headers->{Status}, 200, "client 5 got 200";
    is $headers->{'content-type'}, 'text/plain; charset=UTF-8';

    $body = Encode::decode_utf8($body) unless Encode::is_utf8($body);

    is $headers->{'content-length'}, bytes::length($body),
        'client 5 content-length was calculated correctly';

    is $body, "Oh Hai 5\n", 'client 5 expected body';
    $cv->end;
};

$cv->recv;
pass "all done";