Commit ce3a777a authored by David Golden's avatar David Golden

Add test case for GET with extra headers

parent 7bb9ea37
......@@ -4,31 +4,47 @@ use strict;
use warnings;
use Test::More 0.88;
use t::Util qw[tmpfile rewind slurp monkey_patch dir_list
use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
set_socket_source sort_headers $CRLF $LF];
use HTTP::Tiny;
BEGIN { monkey_patch() }
for my $case ( dir_list("t/cases", qr/^get/ ) ) {
my $data = do { local (@ARGV,$/) = $case; <> };
my ($url, $expect_req, $give_res) = split /--+\n/, $data;
chomp $url;
for my $file ( dir_list("t/cases", qr/^get/ ) ) {
my $data = do { local (@ARGV,$/) = $file; <> };
my ($params, $expect_req, $give_res) = split /--+\n/, $data;
# cleanup source data
my $version = HTTP::Tiny->VERSION || 0;
$expect_req =~ s{VERSION}{$version};
s{\n}{$CRLF}g for ($expect_req, $give_res);
# figure out what request to make
my $case = parse_case($params);
my $url = $case->{url}->[0];
my %options;
my %headers;
for my $line ( @{ $case->{headers} } ) {
my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g);
$headers{$k} = $v;
}
$options{headers} = \%headers if %headers;
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new;
set_socket_source($req_fh, $res_fh);
my $response = $http->get($url);
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->get(@call_args);
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "get('$url') request" );
is( $response->{status}, '200', "get('$url') response" )
my $label = "get on $url";
$label .= " (@{[keys %options]})" if %options;
is( sort_headers($got_req), sort_headers($expect_req), "$label request" );
is( $response->{status}, '200', "$label response" )
or diag $response->{content};
}
......
......@@ -12,6 +12,7 @@ BEGIN {
tmpfile
dir_list
slurp
parse_case
sort_headers
set_socket_source
monkey_patch
......@@ -75,6 +76,23 @@ sub slurp (*) {
return $buf;
}
sub parse_case {
my ($case) = @_;
my %args;
my $key = '';
for my $line ( split "\n", $case ) {
chomp $line;
if ( substr($line,0,1) eq q{ } ) {
$line =~ s/^\s+//;
push @{$args{$key}}, $line;
}
else {
$key = $line;
}
}
return \%args;
}
sub sort_headers {
my ($text) = shift;
my @lines = split /$CRLF/, $text;
......
http://example.com/index.html
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
......
url
http://example.com/index.html
headers
Accept: */*
X-Custom: This is a custom header
----------
GET /index.html HTTP/1.1
Host: example.com
Accept: */*
Connection: close
User-Agent: HTTP-Tiny/VERSION
X-Custom: This is a custom header
----------
HTTP/1.1 200 OK
Date: Thu, 03 Feb 1994 00:00:00 GMT
Content-Type: text/plain
Content-Length: 42
abcdefghijklmnopqrstuvwxyz1234567890abcdef
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment