cpan/HTTP-Tiny/t/150_post_form.t

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