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