150_post_form.t revision 1.1
1#!perl 2 3use strict; 4use warnings; 5use open IN => ':raw'; 6 7use File::Basename; 8use Test::More 0.88; 9use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case 10 set_socket_source sort_headers $CRLF $LF]; 11use HTTP::Tiny; 12BEGIN { monkey_patch() } 13 14for my $file ( dir_list("t/cases", qr/^form/ ) ) { 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 my @params = split "\\|", $case->{content}[0]; 35 my $formdata; 36 if ( $case->{datatype} eq 'HASH' ) { 37 while ( @params ) { 38 my ($key, $value) = splice( @params, 0, 2 ); 39 if ( ref $formdata->{$key} ) { 40 push @{$formdata->{$key}}, $value; 41 } 42 elsif ( exists $formdata->{$key} ) { 43 $formdata->{$key} = [ $formdata->{$key}, $value ]; 44 } 45 else { 46 $formdata->{$key} = $value; 47 } 48 } 49 } 50 else { 51 $formdata = [ @params ]; 52 } 53 54 # setup mocking and test 55 my $res_fh = tmpfile($give_res); 56 my $req_fh = tmpfile(); 57 58 my $http = HTTP::Tiny->new; 59 set_socket_source($req_fh, $res_fh); 60 61 (my $url_basename = $url) =~ s{.*/}{}; 62 63 my $response = $http->post_form( $url, $formdata, %options ? (\%options) : ()); 64 65 my $got_req = slurp($req_fh); 66 67 my $label = basename($file); 68 69 is( sort_headers($got_req), sort_headers($expect_req), "$label request" ); 70 71 my ($rc) = $give_res =~ m{\S+\s+(\d+)}g; 72 is( $response->{status}, $rc, "$label response code $rc" ) 73 or diag $response->{content}; 74 75 if ( substr($rc,0,1) eq '2' ) { 76 ok( $response->{success}, "$label success flag true" ); 77 } 78 else { 79 ok( ! $response->{success}, "$label success flag false" ); 80 } 81} 82 83done_testing; 84