1#!perl
2
3use strict;
4use warnings;
5
6use File::Basename;
7use Test::More 0.96;
8use lib 't';
9use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
10  hashify connect_args clear_socket_source set_socket_source sort_headers
11  $CRLF $LF];
12
13use HTTP::Tiny;
14BEGIN { monkey_patch() }
15
16SKIP: for my $class ( qw/SimpleCookieJar HTTP::CookieJar/ ) {
17
18    subtest $class => sub {
19        eval "require $class; 1"
20            or plan skip_all => "Needs $class";
21
22        for my $file ( dir_list("corpus", qr/^cookies/ ) ) {
23            my $label = basename($file);
24            my $data = do { local (@ARGV,$/) = $file; <> };
25            my @cases = split /--+\n/, $data;
26
27            my $jar = SimpleCookieJar->new();
28            my $http = undef;
29            while (@cases) {
30                my ($params, $expect_req, $give_res) = splice( @cases, 0, 3 );
31
32                my $case = parse_case($params);
33
34                my $url = $case->{url}[0];
35                my $method = $case->{method}[0] || 'GET';
36                my %headers = hashify( $case->{headers} );
37                my %new_args = hashify( $case->{new_args} );
38
39                if( exists $headers{Cookie} ) {
40                my $cookies = delete $headers{Cookie};
41                $jar->add( $url, $cookies );
42                }
43
44                if( exists $headers{'No-Cookie-Jar'} ) {
45                delete $headers{'No-Cookie-Jar'};
46                $jar = undef;
47                }
48
49                my %options;
50                $options{headers} = \%headers if %headers;
51
52                my $version = HTTP::Tiny->VERSION || 0;
53                my $agent = $new_args{agent} || "HTTP-Tiny/$version";
54
55                $new_args{cookie_jar} = $jar;
56
57                # cleanup source data
58                $expect_req =~ s{HTTP-Tiny/VERSION}{$agent};
59                s{\n}{$CRLF}g for ($expect_req, $give_res);
60
61                # setup mocking and test
62                my $res_fh = tmpfile($give_res);
63                my $req_fh = tmpfile();
64
65                $http = HTTP::Tiny->new(keep_alive => 0, %new_args) if !defined $http;
66                clear_socket_source();
67                set_socket_source($req_fh, $res_fh);
68
69                my @call_args = %options ? ($url, \%options) : ($url);
70                my $response  = $http->get(@call_args);
71
72                my $got_req = slurp($req_fh);
73                is( sort_headers($got_req), sort_headers($expect_req), "$label request data");
74            }
75        }
76    };
77}
78
79done_testing;
80