#!/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 = 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;
},
]
];
};
test_tcp_plackup(
$app,
sub {
my $base_uri = shift;
test_responses($base_uri, Plack::Client->new(http => {}));
},
);
{
my $apps = {
foo => $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');
my $env = HTTP::Request->new(GET => $uri)->to_psgi;
$env->{'plack.client.original_uri'} = $base;
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');
my $env = HTTP::Request->new(GET => $uri)->to_psgi;
$env->{'plack.client.original_uri'} = $base;
response_is(
$client->request(Plack::Request->new($env)),
200,
['Content-Type' => 'text/plain', 'Content-Length' => '7'],
"GET\n/\n\n"
);
}
}
done_testing;