02-inputs.t

#!/usr/bin/env perl
use strict;
use warnings;
use lib 't/lib';
use Test::More;
use Plack::Client::Test;

use HTTP::Message::PSGI;

my $app = <<'APP';
sub {
    my $env = shift;
    return [
        200,
        ['Content-Type' => 'text/plain'],
        [
            (map { ($env->{$_} || '') . "\n" }
                 qw(
                    REQUEST_METHOD
                    REQUEST_URI
                    CONTENT_LENGTH
                 )),
            (map { ucfirst(lc) . ': ' . $env->{"HTTP_X_$_"} . "\n" }
                 grep { $_ ne 'FORWARDED_FOR' } grep { s/^HTTP_X_// }
                      keys %$env),
            do {
                my $fh = $env->{'psgi.input'};
                $fh->read(my $body, $env->{CONTENT_LENGTH});
                $body;
            },
        ]
    ];
}
APP

test_tcp_plackup(
    $app,
    sub {
        my $base_uri = shift;

        test_responses($base_uri, Plack::Client->new);
    },
);

{
    my $apps = {
        foo => eval $app,
    };
    my $base_uri = 'psgi-local://foo';

    test_responses(
        $base_uri,
        Plack::Client->new('psgi-local' => {apps => $apps})
    );
}

sub test_responses {
    my ($base_uri, $client) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    response_is(
        $client->get($base_uri),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '7'],
        "GET\n/\n\n"
    );

    response_is(
        $client->get($base_uri . '/'),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '7'],
        "GET\n/\n\n"
    );

    response_is(
        $client->get($base_uri . '/foo'),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '10'],
        "GET\n/foo\n\n"
    );

    response_is(
        $client->get($base_uri . '/foo', ['X-Foo' => 'bar']),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '19'],
        "GET\n/foo\n\nFoo: bar\n"
    );

    response_is(
        $client->get($base_uri . '/foo', HTTP::Headers->new('X-Foo' => 'bar')),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '19'],
        "GET\n/foo\n\nFoo: bar\n"
    );

    response_is(
        $client->post($base_uri, [], "foo"),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '12'],
        "POST\n/\n3\nfoo",
    );

    response_is(
        $client->put($base_uri, [], "foo"),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '11'],
        "PUT\n/\n3\nfoo",
    );

    response_is(
        $client->delete($base_uri),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '10'],
        "DELETE\n/\n\n",
    );

    response_is(
        $client->head($base_uri),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '8'],
        "", # length("HEAD\n/\n\n") == 8
    );

    response_is(
        $client->request(HTTP::Request->new(GET => $base_uri)),
        200,
        ['Content-Type' => 'text/plain', 'Content-Length' => '7'],
        "GET\n/\n\n"
    );

    {
        my $base = URI->new($base_uri);
        my $uri = $base->clone;
        $uri->scheme('http');
        $uri->path('/') unless $uri->path; # XXX: work around plack bug
        my $env = HTTP::Request->new(GET => $uri)->to_psgi;
        $env->{CONTENT_LENGTH} = 0; # XXX: work around plack bug
        $env->{'plack.client.url_scheme'} = $base->scheme;
        $env->{'plack.client.app_name'} = $base->authority
            if $base->scheme eq 'psgi-local';
        response_is(
            $client->request($env),
            200,
            ['Content-Type' => 'text/plain', 'Content-Length' => '7'],
            "GET\n/\n\n"
        );
    }

    {
        my $base = URI->new($base_uri);
        my $uri = $base->clone;
        $uri->scheme('http');
        $uri->path('/') unless $uri->path; # XXX: work around plack bug
        my $env = HTTP::Request->new(GET => $uri)->to_psgi;
        $env->{CONTENT_LENGTH} = 0; # XXX: work around plack bug
        $env->{'plack.client.url_scheme'} = $base->scheme;
        $env->{'plack.client.app_name'} = $base->authority
            if $base->scheme eq 'psgi-local';
        response_is(
            $client->request(Plack::Request->new($env)),
            200,
            ['Content-Type' => 'text/plain', 'Content-Length' => '7'],
            "GET\n/\n\n"
        );
    }
}

done_testing;