|
Packit |
3f4df8 |
#!perl
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
use strict;
|
|
Packit |
3f4df8 |
use warnings;
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
use File::Basename;
|
|
Packit |
3f4df8 |
use Test::More 0.88;
|
|
Packit |
3f4df8 |
use lib 't';
|
|
Packit |
3f4df8 |
use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
|
|
Packit |
3f4df8 |
hashify connect_args clear_socket_source set_socket_source sort_headers
|
|
Packit |
3f4df8 |
$CRLF $LF];
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
use HTTP::Tiny;
|
|
Packit |
3f4df8 |
BEGIN { monkey_patch() }
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
for my $file ( dir_list("corpus", qr/^auth/ ) ) {
|
|
Packit |
3f4df8 |
my $label = basename($file);
|
|
Packit |
3f4df8 |
my $data = do { local (@ARGV,$/) = $file; <> };
|
|
Packit |
3f4df8 |
my ($params, @case_pairs) = split /--+\n/, $data;
|
|
Packit |
3f4df8 |
my $case = parse_case($params);
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my $url = $case->{url}[0];
|
|
Packit |
3f4df8 |
my $method = $case->{method}[0] || 'GET';
|
|
Packit |
3f4df8 |
my %headers = hashify( $case->{headers} );
|
|
Packit |
3f4df8 |
my %new_args = hashify( $case->{new_args} );
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my %options;
|
|
Packit |
3f4df8 |
$options{headers} = \%headers if %headers;
|
|
Packit |
3f4df8 |
my $call_args = %options ? [$method, $url, \%options] : [$method, $url];
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my $version = HTTP::Tiny->VERSION || 0;
|
|
Packit |
3f4df8 |
my $agent = $new_args{agent} || "HTTP-Tiny/$version";
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my (@socket_pairs);
|
|
Packit |
3f4df8 |
while ( @case_pairs ) {
|
|
Packit |
3f4df8 |
my ($expect_req, $give_res) = splice( @case_pairs, 0, 2 );
|
|
Packit |
3f4df8 |
# cleanup source data
|
|
Packit |
3f4df8 |
$expect_req =~ s{HTTP-Tiny/VERSION}{$agent};
|
|
Packit |
3f4df8 |
s{\n}{$CRLF}g for ($expect_req, $give_res);
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
# setup mocking and test
|
|
Packit |
3f4df8 |
my $req_fh = tmpfile();
|
|
Packit |
3f4df8 |
my $res_fh = tmpfile($give_res);
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
push @socket_pairs, [$req_fh, $res_fh, $expect_req];
|
|
Packit |
3f4df8 |
}
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
clear_socket_source();
|
|
Packit |
3f4df8 |
set_socket_source(@$_) for @socket_pairs;
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
|
|
Packit |
3f4df8 |
my $response = $http->request(@$call_args);
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my $calls = 0
|
|
Packit |
3f4df8 |
+ (defined($new_args{max_redirect}) ? $new_args{max_redirect} : 5);
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
for my $i ( 0 .. $calls ) {
|
|
Packit |
3f4df8 |
last unless @socket_pairs;
|
|
Packit |
3f4df8 |
my ($req_fh, $res_fh, $expect_req) = @{ shift @socket_pairs };
|
|
Packit |
3f4df8 |
my $got_req = slurp($req_fh);
|
|
Packit |
3f4df8 |
is( sort_headers($got_req), sort_headers($expect_req), "$label request ($i)");
|
|
Packit |
3f4df8 |
$i++;
|
|
Packit |
3f4df8 |
}
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
my $exp_content = $case->{expected}
|
|
Packit |
3f4df8 |
? join("$CRLF", @{$case->{expected}}) : '';
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
is ( $response->{content}, $exp_content, "$label content" );
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
if ( $case->{expected_url} ) {
|
|
Packit |
3f4df8 |
is ( $response->{url}, $case->{expected_url}[0], "$label response URL" );
|
|
Packit |
3f4df8 |
}
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
}
|
|
Packit |
3f4df8 |
|
|
Packit |
3f4df8 |
done_testing;
|