diff options
author | Karl Berry <karl@freefriends.org> | 2014-04-23 21:46:20 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2014-04-23 21:46:20 +0000 |
commit | 300c1eb6d37d46078d448d6d58938d5a80cd68ff (patch) | |
tree | 23a0a8b9f8f5460b405119c4d3c163d2d488ca5e /Master/tlpkg/tlperl/lib/Net/HTTP | |
parent | ed55d86b7c5e18f6eccce80a1fb1423ca40a23b5 (diff) |
(tl)perl 5.18.2 for windows from siep
git-svn-id: svn://tug.org/texlive/trunk@33648 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Net/HTTP')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm | 49 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm | 6 |
2 files changed, 44 insertions, 11 deletions
diff --git a/Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm b/Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm index 738e95f3347..98b58c54907 100644 --- a/Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm +++ b/Master/tlpkg/tlperl/lib/Net/HTTP/Methods.pm @@ -5,7 +5,7 @@ require 5.005; # 4-arg substr use strict; use vars qw($VERSION); -$VERSION = "6.00"; +$VERSION = "6.06"; my $CRLF = "\015\012"; # "\r\n" is not portable @@ -233,6 +233,7 @@ sub my_read { return length($_[0]); } else { + die "read timeout" unless $self->can_read; return $self->sysread($_[0], $len); } } @@ -255,15 +256,10 @@ sub my_readline { # need to read more data to find a line ending READ: { + die "read timeout" unless $self->can_read; my $n = $self->sysread($_, 1024, length); unless (defined $n) { - redo READ if $!{EINTR}; - if ($!{EAGAIN}) { - # Hmm, we must be reading from a non-blocking socket - # XXX Should really wait until this socket is readable,... - select(undef, undef, undef, 0.1); # but this will do for now - redo READ; - } + redo READ if $!{EINTR} || $!{EAGAIN}; # if we have already accumulated some data let's at least # return that as a line die "$what read failed: $!" unless length; @@ -284,6 +280,38 @@ sub my_readline { } +sub can_read { + my $self = shift; + return 1 unless defined(fileno($self)); + return 1 if $self->isa('IO::Socket::SSL') && $self->pending; + + # With no timeout, wait forever. An explict timeout of 0 can be + # used to just check if the socket is readable without waiting. + my $timeout = @_ ? shift : (${*$self}{io_socket_timeout} || undef); + + my $fbits = ''; + vec($fbits, fileno($self), 1) = 1; + SELECT: + { + my $before; + $before = time if $timeout; + my $nfound = select($fbits, undef, undef, $timeout); + if ($nfound < 0) { + if ($!{EINTR} || $!{EAGAIN}) { + # don't really think EAGAIN can happen here + if ($timeout) { + $timeout -= time - $before; + $timeout = 0 if $timeout < 0; + } + redo SELECT; + } + die "select failed: $!"; + } + return $nfound > 0; + } +} + + sub _rbuf { my $self = shift; if (@_) { @@ -415,6 +443,7 @@ sub read_entity_body { my @te = split(/\s*,\s*/, lc($te)); die "Chunked must be last Transfer-Encoding '$te'" unless pop(@te) eq "chunked"; + pop(@te) while @te && $te[-1] eq "chunked"; # ignore repeated chunked spec for (@te) { if ($_ eq "deflate" && inflate_ok()) { @@ -489,6 +518,7 @@ sub read_entity_body { die "Bad chunk-size in HTTP response: $line"; } $chunked = hex($1); + ${*$self}{'http_chunked'} = $chunked; if ($chunked == 0) { ${*$self}{'http_trailers'} = [$self->_read_header_lines]; $$buf_ref = ""; @@ -536,8 +566,7 @@ sub read_entity_body { my $n = $bytes; $n = $size if $size && $size < $n; $n = my_read($self, $$buf_ref, $n); - return undef unless defined $n; - ${*$self}{'http_bytes'} = $bytes - $n; + ${*$self}{'http_bytes'} = defined $n ? $bytes - $n : $bytes; return $n; } else { diff --git a/Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm b/Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm index 78871116338..6049e054914 100644 --- a/Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm +++ b/Master/tlpkg/tlperl/lib/Net/HTTP/NB.pm @@ -3,11 +3,15 @@ package Net::HTTP::NB; use strict; use vars qw($VERSION @ISA); -$VERSION = "6.00"; +$VERSION = "6.04"; require Net::HTTP; @ISA=qw(Net::HTTP); +sub can_read { + return 1; +} + sub sysread { my $self = $_[0]; if (${*$self}{'httpnb_read_count'}++) { |