File Coverage

blib/lib/Net/HTTP/Client.pm

Criterion	Covered	Total	%
statement	42	44	95.4
branch	9	16	56.2
condition	7	17	41.1
subroutine	9	9	100.0
pod	3	3	100.0
total	70	89	78.6

package Net::HTTP::Client;
$Net::HTTP::Client::VERSION = '0.012';
use 5.10.0;
use strict;
use warnings;

use Errno qw(EINTR EIO :POSIX);
use HTTP::Response;

use parent qw/Net::HTTP/;

my $DEBUG = 0;
my $used = 0;

sub new {
    my $class = shift;
    $class->SUPER::new(@_);
}

sub request {
    my ($self, $method, $uri, @headers) = @_;

    my $content = (@headers % 2) ? pop @headers : '';

    if ($uri !~ /^\//) {
        my $host;
        ($host, $uri) = split /\//, $uri, 2;
        warn "New connection to host $host\n" if $DEBUG;
        $self = $self->new(Host => $host) || die $@;
        $uri = '/' . ($uri // '');
    } elsif ($used and !$self->keep_alive // 0) {
        warn 'Reconnecting to ', $self->peerhost, ':', $self->peerport, "\n" if $DEBUG;
        $self = $self->new(Host => $self->peerhost, PeerPort => $self->peerport) || die $@;
    }
    $used = 1;
    warn "$method $uri\n" if $DEBUG;

    my $success = $self->print( $self->format_request($method => $uri, @headers, $content) );
    my ($status, $message, @res_headers) = $self->read_response_headers;
    HTTP::Response->new($status, $message, \@res_headers, $self->get_content());
}

sub get_content {
    my ($self) = @_;
    my $content = '';
    while (1) {
        my $buf;
        my $n = $self->read_entity_body($buf, 1024);
        die "read failed: $!" unless defined $n or $!{EINTR} or $!{EAGAIN};
        last unless $n;
        $content .= $buf;
    }
    $content;
}

1;

__END__