File Coverage

blib/lib/WebService/Client.pm

Criterion	Covered	Total	%
statement	64	109	58.7
branch	13	38	34.2
condition	5	13	38.4
subroutine	16	21	76.1
pod	7	8	87.5
total	105	189	55.5

package WebService::Client;
use Moo::Role;

our $VERSION = '1.0001'; # VERSION

use Carp qw(croak);
use HTTP::Request;
use HTTP::Request::Common qw(DELETE GET POST PUT);
use JSON::MaybeXS ();
use LWP::UserAgent;
use WebService::Client::Response;

has base_url => (
    is      => 'rw',
    default => sub { '' },
);

has ua => (
    is      => 'ro',
    lazy    => 1,
    default => sub { LWP::UserAgent->new(timeout => shift->timeout) },
);

has timeout => (
    is      => 'ro',
    default => sub { 10 },
);

has retries => (
    is      => 'ro',
    default => sub { 0 },
    isa     => sub {
        my $r = shift;
        die 'retries must be a nonnegative integer'
            unless defined $r and $r =~ /^\d+$/;
    },
);

has logger => ( is => 'ro' );

has log_method => (
    is      => 'ro',
    default => sub { 'DEBUG' },
);

has content_type => (
    is      => 'rw',
    default => sub { 'application/json' },
);

has deserializer => (
    is      => 'ro',
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $json = $self->json;
        sub {
            my ($res, %args) = @_;
            return $json->decode($res->content);
        }
    },
);

has serializer => (
    is      => 'ro',
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $json = $self->json;
        sub {
            my ($data, %args) = @_;
            # TODO: remove the next line after clients are updated to inject
            # custom serializers that will handle this logic
            return $data unless _content_type($args{headers}) =~ /json/;
            return $json->encode($data);
        }
    }
);

has json => (
    is      => 'ro',
    lazy    => 1,
    default => sub { JSON::MaybeXS->new() },
);

has mode => (
    is      => 'ro',
    default => sub { '' },
);

sub get {
    my ($self, $path, $params, %args) = @_;
    $params ||= {};
    my $headers = $self->_headers(\%args);
    my $url = $self->_url($path);
    my $q = '';
    if (%$params) {
        my @items;
        while (my ($key, $value) = each %$params) {
            if ('ARRAY' eq ref $value) {
                push @items, map "$key\[]=$_", @$value;
            }
            else {
                push @items, "$key=$value";
            }
        }
        if (@items) {
            $q = '?' . join '&', @items;
        }
    }
    my $req = GET "$url$q", %$headers;
    return $self->req($req, %args);
}

sub post {
    my ($self, $path, $data, %args) = @_;
    my $headers = $self->_headers(\%args);
    my $url = $self->_url($path);
    my $req = POST $url, %$headers, $self->_content($data, %args);
    return $self->req($req, %args);
}

sub put {
    my ($self, $path, $data, %args) = @_;
    my $headers = $self->_headers(\%args);
    my $url = $self->_url($path);
    my $req = PUT $url, %$headers, $self->_content($data, %args);
    return $self->req($req, %args);
}

sub patch {
    my ($self, $path, $data, %args) = @_;
    my $headers = $self->_headers(\%args);
    my $url = $self->_url($path);
    my %content = $self->_content($data, %args);
    my $req = HTTP::Request->new(
        'PATCH', $url, [%$headers], $content{content}
    );
    return $self->req($req, %args);
}

sub delete {
    my ($self, $path, %args) = @_;
    my $headers = $self->_headers(\%args);
    my $url = $self->_url($path);
    my $req = DELETE $url, %$headers;
    return $self->req($req, %args);
}

sub req {
    my ($self, $req, %args) = @_;
    $self->_log_request($req);
    my $res = $self->ua->request($req);
    $self->_log_response($res);

    my $retries = $self->retries;
    while ($res->code =~ /^5/ and $retries--) {
        sleep 1;
        $res = $self->ua->request($req);
        $self->_log_response($res);
    }

    $self->prepare_response($res);

    if ($self->mode eq 'v2') {
        return WebService::Client::Response->new(
            res  => $res,
            json => $self->json,
        );
    }

    return if $req->method eq 'GET' and $res->code =~ /404|410/;
    die $res unless $res->is_success;
    return 1 unless $res->content;
    my $des = $self->deserializer;
    $des = $args{deserializer} if exists $args{deserializer};
    if ($des) {
        die 'deserializer must be a coderef or undef'
            unless 'CODE' eq ref $des;
        return $des->($res, %args);
    }
    else {
        return $res->content;
    }
}

sub log {
    my ($self, $msg) = @_;
    return unless $self->logger;
    my $log_method = $self->log_method;
    $self->logger->$log_method($msg);
}

sub prepare_response {
    my ($self, $res) = @_;
    Moo::Role->apply_roles_to_object($res, 'HTTP::Response::Stringable');
    return;
}

sub _url {
    my ($self, $path) = @_;
    croak 'The path is missing' unless defined $path;
    return $path =~ /^http/ ? $path : $self->base_url . $path;
}

sub _headers {
    my ($self, $args) = @_;
    my $headers = $args->{headers} ||= {};
    croak 'The headers param must be a hashref' unless 'HASH' eq ref $headers;
    $headers->{content_type} = $self->content_type
        unless _content_type($headers);
    return $headers;
}

sub _log_request {
    my ($self, $req) = @_;
    $self->log(ref($self) . " REQUEST:\n" . $req->as_string);
}

sub _log_response {
    my ($self, $res) = @_;
    $self->log(ref($self) . " RESPONSE:\n" . $res->as_string);
}

sub _content_type {
    my ($headers) = @_;
    return $headers->{'Content-Type'}
        || $headers->{'content-type'}
        || $headers->{content_type};
}

sub _content {
    my ($self, $data, %args) = @_;
    my @content;
    if (defined $data) {
        my $ser = $self->serializer;
        $ser = $args{serializer} if exists $args{serializer};
        if ($ser) {
            die 'serializer must be a coderef or undef'
                unless 'CODE' eq ref $ser;
            $data = $ser->($data, %args);
        }
        @content = ( content => $data );
    }
    return @content;
}

# ABSTRACT: A base role for quickly and easily creating web service clients


1;

__END__