102_put.t revision 1.4
1#!perl 2 3use strict; 4use warnings; 5 6use File::Basename; 7use Test::More 0.88; 8use lib 't'; 9use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case 10 clear_socket_source set_socket_source sort_headers $CRLF $LF]; 11use HTTP::Tiny; 12BEGIN { monkey_patch() } 13 14for my $file ( dir_list("corpus", qr/^put/ ) ) { 15 my $data = do { local (@ARGV,$/) = $file; <> }; 16 my ($params, $expect_req, $give_res) = split /--+\n/, $data; 17 # cleanup source data 18 my $version = HTTP::Tiny->VERSION || 0; 19 $expect_req =~ s{VERSION}{$version}; 20 s{\n}{$CRLF}g for ($expect_req, $give_res); 21 22 # figure out what request to make 23 my $case = parse_case($params); 24 my $url = $case->{url}[0]; 25 my %options; 26 27 my %headers; 28 for my $line ( @{ $case->{headers} } ) { 29 my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g); 30 $headers{$k} = $v; 31 } 32 $options{headers} = \%headers if %headers; 33 34 if ( $case->{content} ) { 35 $options{content} = $case->{content}[0]; 36 } 37 elsif ( exists $case->{content} ) { 38 $options{content} = ""; 39 } 40 elsif ( $case->{content_cb} ) { 41 $options{content} = eval join "\n", @{$case->{content_cb}}; 42 } 43 44 if ( $case->{trailer_cb} ) { 45 $options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}}; 46 } 47 48 # setup mocking and test 49 my $res_fh = tmpfile($give_res); 50 my $req_fh = tmpfile(); 51 52 my $http = HTTP::Tiny->new( keep_alive => 0 ); 53 clear_socket_source(); 54 set_socket_source($req_fh, $res_fh); 55 56 (my $url_basename = $url) =~ s{.*/}{}; 57 58 my @call_args = %options ? ($url, \%options) : ($url); 59 my $response = $http->put(@call_args); 60 61 my $got_req = slurp($req_fh); 62 63 my $label = basename($file); 64 65 is( sort_headers($got_req), sort_headers($expect_req), "$label request" ); 66 67 my ($rc) = $give_res =~ m{\S+\s+(\d+)}g; 68 is( $response->{status}, $rc, "$label response code $rc" ) 69 or diag $response->{content}; 70 71 if ( substr($rc,0,1) eq '2' ) { 72 ok( $response->{success}, "$label success flag true" ); 73 } 74 else { 75 ok( ! $response->{success}, "$label success flag false" ); 76 } 77} 78 79done_testing; 80