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