File Coverage

blib/lib/Net/HTTP/Client.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	10	16	62.5
condition	7	17	41.1
subroutine	8	8	100.0
pod	3	3	100.0
total	69	85	81.1

package Net::HTTP::Client;

=head1 NAME

Net::HTTP::Client - A Not-quite-so-low-level HTTP connection (client)

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

  use Net::HTTP::Client;

  my $client = Net::HTTP::Client->new(Host => 'localhost', KeepAlive => 0);

  my $res = $client->request(POST => '/foo', 'fizz buzz');

  if ($res->is_success) {
    print $res->decoded_content;
  } else {
    warn $res->status_line, "\n";
  }

  # a new connection to www.example.com
  $res = $client->request(GET => 'www.example.com');

  # another connection to www.example.com
  $res = $client->request(GET => 'www.example.com/foo');

  # a new connection to localhost:3335
  $res = $client->request(GET => 'localhost/bar');

  # original connection to localhost:3335 IFF KeepAlive is set, otherwise a new connection
  $res = $client->request(POST => '/baz', 'foo');


  # or you can skip calling new()
  $res = Net::HTTP::Client->request(POST => 'localhost:3335/foo', 'Content-Type' => 'application/x-www-form-urlencoded', 'foo=fizz+buzz');

=head1 DESCRIPTION

C provides a simple interface to L, and is a sub-class of it.

=over 2

=cut

use 5.12.0;
use warnings;

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

use parent qw/Net::HTTP/;

our $VERSION = '0.01';

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

=item new(%options)

The C constructor method takes the same options as L, with the
same requirements.

=cut

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

=item request($method, $uri, @headers?, $content?)

Sends a request with method C<$method> and path C<$uri>. Key-value pairs of
C<@headers> and C<$content> are optional. If C is set at C,
multiple calls to this will use the same connection. Otherwise, a new
connection will be created automatically. In addition, a C<$uri> may contain a
different host and port, in which case it will make a new connection. For
convenience, if you don't wish to reuse connections, you may call this method
directly without invoking C if C<$uri> contains a host.

Returns an L object.

=cut

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());
}

=item get_content()

Reads and returns the body content of the response. This is called by
C, so don't use this if using that.

=cut

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;
}

=back

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014 by Ashley Willis [e-mail]

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.12.4 or,
at your option, any later version of Perl 5 you may have available.

=head1 SEE ALSO

L

=cut

1;