view release on metacpan or  search on metacpan

t/0004-server.t  view on Meta::CPAN

    }
    $req .= "\r\n";
    $req .= $a{body} if defined $a{body};
    print $s $req;
    my $raw = '';
    while (my $c = <$s>) { $raw .= $c }
    close $s;
    my ($head, $body) = split /\r\n\r\n/, $raw, 2;
    my @lines  = split /\r\n/, $head;
    my $status = shift @lines;
    my %h;
    for (@lines) { $h{lc $1} = $2 if /^([^:]+):\s*(.*)$/ }
    return ($status, { %h }, defined $body ? $body : '');
}

# --- GET /hello (ok 2-6) ------------------------------------------------
my ($st, $hh, $bo);
($st, $hh, $bo) = http_req(path => '/hello');

# ok 2: status 200
like($st, qr{^HTTP/1\.0 200}, 'GET /hello: 200');
# ok 3: response body
is($bo, 'Hello, World!', 'GET /hello: body');
# ok 4: status line format is "HTTP/1.0 NNN <reason>"
like($st, qr{^HTTP/1\.0 \d{3} \S}, 'status line format');
# ok 5: Connection: close header is present
like(lc(defined $hh->{connection} ? $hh->{connection} : ''), qr{close}, 'Connection: close');
# ok 6: Content-Type header is present
like($hh->{'content-type'}, qr{text/plain}, 'Content-Type');

# --- Request data mapped to $env (ok 7-9) -------------------------------

# ok 7: REQUEST_METHOD is GET
($st, $hh, $bo) = http_req(path => '/echo-method');
is($bo, 'GET', 'REQUEST_METHOD GET');

# ok 8: QUERY_STRING is populated
($st, $hh, $bo) = http_req(path => '/echo-query?foo=bar&baz=1');
is($bo, 'foo=bar&baz=1', 'QUERY_STRING');

# ok 9: User-Agent header maps to HTTP_USER_AGENT
($st, $hh, $bo) = http_req(path => '/echo-header', headers => {'User-Agent' => 'NanoTest/1.0'});
is($bo, 'NanoTest/1.0', 'HTTP_USER_AGENT');

# --- Status codes (ok 10-14) --------------------------------------------

# ok 10: app returns 404
($st) = http_req(path => '/status/404');
like($st, qr{^HTTP/1\.0 404}, '404');

# ok 11: app returns 500
($st) = http_req(path => '/status/500');
like($st, qr{^HTTP/1\.0 500}, '500');

# ok 12: app die is converted to 500
($st) = http_req(path => '/die');
like($st, qr{^HTTP/1\.0 500}, 'app die -> 500');

# ok 13: server continues to accept requests after an app die
($st) = http_req(path => '/hello');
like($st, qr{^HTTP/1\.0 200}, 'alive after die');

# ok 14: unsupported method returns 405
($st) = http_req(method => 'DELETE', path => '/hello');
like($st, qr{^HTTP/1\.0 405}, 'DELETE -> 405');

# --- POST (ok 15-16) ----------------------------------------------------

# ok 15: REQUEST_METHOD is POST
($st, $hh, $bo) = http_req(method => 'POST', path => '/echo-method');
is($bo, 'POST', 'POST method');

# ok 16: POST body is readable via psgi.input
($st, $hh, $bo) = http_req(method => 'POST', path => '/echo-post', body => 'name=ina&lang=perl');
is($bo, 'name=ina&lang=perl', 'POST body');

# --- Miscellaneous (ok 17-21) -------------------------------------------

# ok 17: multi-element body array is joined before sending
($st, $hh, $bo) = http_req(path => '/multi-body');
is($bo, 'part1part2part3', 'multi-body joined');

# ok 18: custom response header is delivered to the client
($st, $hh) = http_req(path => '/custom-header');
is($hh->{'x-http-handy'}, 'test-value', 'custom header');

# ok 19: unknown path returns 404
($st) = http_req(path => '/no/such/path');
like($st, qr{^HTTP/1\.0 404}, 'unknown path 404');

# ok 20: QUERY_STRING is empty when no query string is present
($st, $hh, $bo) = http_req(path => '/echo-query');
is($bo, '', 'empty QUERY_STRING');

# ok 21: QUERY_STRING is separated from PATH_INFO
($st, $hh, $bo) = http_req(path => '/echo-query?x=1');
is($bo, 'x=1', 'QUERY_STRING from PATH_INFO');

exit($FAIL ? 1 : 0);