This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update HTTP-Tiny to CPAN version 0.015
[perl5.git] / cpan / HTTP-Tiny / t / 150_post_form.t
CommitLineData
a3ab329f 1#!perl
a3ab329f
DG
2
3use strict;
4use warnings;
293dcbbb 5use open IN => ':raw';
a3ab329f
DG
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
35265876 14for my $file ( dir_list("t/cases", qr/^form/ ) ) {
a3ab329f
DG
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
35265876
CBW
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 }
a3ab329f 49 }
35265876
CBW
50 else {
51 $formdata = [ @params ];
a3ab329f
DG
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
35265876 63 my $response = $http->post_form( $url, $formdata, %options ? (\%options) : ());
a3ab329f
DG
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;