1#!perl 2 3use strict; 4use warnings; 5use File::Basename; 6use Test::More 0.88; 7use t::Util qw[ 8 tmpfile monkey_patch dir_list clear_socket_source set_socket_source 9 $CRLF 10]; 11use HTTP::Tiny; 12our $can_read; 13 14BEGIN { 15 no warnings qw/redefine once/; 16 monkey_patch(); 17 *HTTP::Tiny::Handle::can_read = sub { $can_read++ }; 18} 19 20my $response = <<'RESPONSE'; 21HTTP/1.1 200 OK 22Date: Thu, 03 Feb 1994 00:00:00 GMT 23Content-Type: text/html 24Content-Length: 10 25 260123456789 27 28RESPONSE 29 30trim($response); 31 32my $h; 33 34new_ht(); 35test_ht( "Keep-alive", 1, 'http://foo.com' ); 36 37new_ht(); 38test_ht( "Different scheme", 0, 'https://foo.com' ); 39 40new_ht(); 41test_ht( "Different host", 0, 'http://bar.com' ); 42 43new_ht(); 44test_ht( "Different port", 0, 'http://foo.com:8000' ); 45 46new_ht(); 47$h->timeout(30); 48test_ht( "Different timeout", 0, 'http://foo.com' ); 49 50new_ht(); 51$h->timeout(60); 52test_ht( "Same timeout", 1, 'http://foo.com' ); 53 54new_ht(); 55$h->default_headers({ 'X-Foo' => 'Bar' }); 56test_ht( "Default headers change", 1, 'http://foo.com' ); 57 58new_ht(); 59$h->{handle}->close; 60test_ht( "Socket closed", 0, 'http://foo.com' ); 61 62for my $file ( dir_list( "corpus", qr/^keepalive/ ) ) { 63 my $label = basename($file); 64 my $data = do { local ( @ARGV, $/ ) = $file; <> }; 65 my ( $title, $ok, $response ) = map { trim($_) } split /--+/, $data; 66 new_ht(); 67 clear_socket_source(); 68 set_socket_source( tmpfile(), tmpfile($response) ); 69 $h->request( 'POST', 'http://foo.com', { content => 'xx' } ); 70 is !!$h->{handle}, !!$ok, "$label - $title"; 71} 72 73sub test_ht { 74 my $title = shift; 75 my $result = !!shift(); 76 my $url = shift; 77 78 clear_socket_source(); 79 set_socket_source( tmpfile(), tmpfile($response) ); 80 $can_read = 0 if $result; 81 my $old = $h->{handle} || 'old'; 82 $h->request( 'POST', $url, { content => 'xx' } ); 83 my $new = $h->{handle} || 'new'; 84 is $old eq $new, $result, $title; 85} 86 87sub new_ht { 88 $h = HTTP::Tiny->new( keep_alive => 1, @_ ); 89 $can_read = 1; 90 clear_socket_source(); 91 set_socket_source( tmpfile(), tmpfile($response) ); 92 $h->request( 'POST', 'http://foo.com' ); 93} 94 95sub trim { $_[0] =~ s/^\s+//; $_[0] =~ s/\s+$//; return $_ } 96 97done_testing; 98 99