lwp-http.pm.diff

--- /home/kevin/git/libwww-perl/lib/LWP/Protocol/http.pm	2014-06-10 13:05:28.383259747 -0700
+++ /home/kevin/mylib/lib/perl5/LWP/Protocol/http.pm	2014-06-16 16:32:27.979196405 -0700
@@ -196,21 +196,22 @@
 	    $socket = $upgrade_sub->($proto_https,
 		$response->{client_socket},$url)
 		or die "SSL upgrade failed: $@";
 	} else {
 	    $socket = $proto_https->_new_socket($url->host,$url->port,$timeout);
 	}
     }
 
     if ( ! $socket ) {
 	# connect to remote site w/o reusing established socket
-	$socket = $self->_new_socket($host, $port, $timeout );
+	# $request is there for the convenience of subclassers
+	$socket = $self->_new_socket($host, $port, $timeout, $request );
     }
 
     my $http_version = "";
     if (my $proto = $request->protocol) {
 	if ($proto =~ /^(?:HTTP\/)?(1.\d+)$/) {
 	    $http_version = $1;
 	    $socket->http_version($http_version);
 	    $socket->send_te(0) if $http_version eq "1.0";
 	}
     }
@@ -358,20 +359,21 @@
 	    }
 
 	    if ($write_wait) {
 		$write_wait -= time - $time_before;
 		$write_wait = 0 if $write_wait < 0;
 	    }
 
 	    if (defined($rbits) && $rbits =~ /[^\0]/) {
 		# readable
 		my $buf = $socket->_rbuf;
+		$self->pre_socketread_hook;
 		my $n = $socket->sysread($buf, 1024, length($buf));
                 unless (defined $n) {
                     die "read failed: $!" unless  $!{EINTR} || $!{EAGAIN};
                     # if we get here the rest of the block will do nothing
                     # and we will retry the read on the next round
                 }
 		elsif ($n == 0) {
                     # the server closed the connection before we finished
                     # writing all the request content.  No need to write any more.
                     $drop_connection++;
@@ -413,20 +415,21 @@
 		    $eof++ unless length($buf);
 		    $buf = sprintf "%x%s%s%s", length($buf), $CRLF, $buf, $CRLF
 			if $chunked;
 		    $wbuf = \$buf;
 		    $woffset = 0;
 		}
 	    }
 	} # WRITE
     }
 
+    $self->pre_socketread_hook;
     ($code, $mess, @h) = $socket->read_response_headers(laxed => 1, junk_out => \@junk)
 	unless $code;
     ($code, $mess, @h) = $socket->read_response_headers(laxed => 1, junk_out => \@junk)
 	if $code eq "100";
 
     my $response = HTTP::Response->new($code, $mess);
     my $peer_http_version = $socket->peer_http_version;
     $response->protocol("HTTP/$peer_http_version");
     {
 	local $HTTP::Headers::TRANSLATE_UNDERSCORE;
@@ -446,32 +449,35 @@
 	$response->push_header('Client-Transfer-Encoding', \@te);
     }
     $response->push_header('Client-Response-Num', scalar $socket->increment_response_count);
 
     my $complete;
     $response = $self->collect($arg, $response, sub {
 	my $buf = ""; #prevent use of uninitialized value in SSLeay.xs
 	my $n;
       READ:
 	{
+	    $self->pre_socketread_hook;
 	    $n = $socket->read_entity_body($buf, $size);
             unless (defined $n) {
                 redo READ if $!{EINTR} || $!{EAGAIN} || $!{ENOTTY};
                 die "read failed: $!";
             }
 	    redo READ if $n == -1;
+	    #die 'read timeout' unless($TIME_REMAIN - 1);
 	}
 	$complete++ if !$n;
         return \$buf;
     } );
     $drop_connection++ unless $complete;
 
+    $self->pre_socketread_hook;
     @h = $socket->get_trailers;
     if (@h) {
 	local $HTTP::Headers::TRANSLATE_UNDERSCORE;
 	$response->push_header(@h);
     }
 
     # keep-alive support
     unless ($drop_connection) {
 	if ($cache_key) {
 	    my %connection = map { (lc($_) => 1) }
@@ -480,20 +486,25 @@
 		$connection{"keep-alive"})
 	    {
 		$conn_cache->deposit($self->socket_type, $cache_key, $socket);
 	    }
 	}
     }
 
     $response;
 }
 
+sub pre_socketread_hook {
+	; # no-op, is here for subclassers
+
+}
+
 
 #-----------------------------------------------------------
 package LWP::Protocol::http::SocketMethods;
 
 sub ping {
     my $self = shift;
     !$self->can_read(0);
 }
 
 sub increment_response_count {