File Coverage

blib/lib/API/Client.pm

Criterion	Covered	Total	%
statement	15	79	18.9
branch	0	16	0.0
condition	0	20	0.0
subroutine	5	14	35.7
pod	5	8	62.5
total	25	137	18.2

# ABSTRACT: General-Purpose API Client Abstraction
package API::Client;

use Data::Object::Class;
use Data::Object::Signatures;

use Data::Object::Library qw(
    InstanceOf
    Int
    Str
);

extends 'API::Client::Core';

use Carp ();
use Scalar::Util ();

our $VERSION = '0.03'; # VERSION

# ATTRIBUTES

has casing => (
    is       => 'rw',
    isa      => Str,
    default  => 'lowercase',
    required => 0,
);

has credentials => (
    is       => 'ro',
    isa      => InstanceOf['API::Client::Credentials'],
    required => 0,
);

has identifier => (
    is       => 'rw',
    isa      => Str,
    default  => 'API::Client (Perl)',
    required => 0,
);

has version => (
    is       => 'rw',
    isa      => Str,
    default  => 0,
    required => 0,
);

# METHOD-RESOLUTION

method AUTOLOAD () {

    my @words = split /::/, our $AUTOLOAD;

    my $method  = pop @words;
    my $package = join '::', @words;

    Carp::croak("Undefined subroutine &${package}::$method called")
        unless Scalar::Util::blessed($self) && $self->isa(__PACKAGE__);

    my @segments = @_;
    my @results  = ();

    # attempt to automate path casing
    while (my ($path, $param) = splice @segments, 0, 2) {
        my $casing = $self->casing;

        if (defined $param and $casing eq 'lowercase') {
            $path = lc $path;
        }
        elsif (defined $param and $casing eq 'snakecase') {
            my ($first, @remaining) = split /_/, $path;
            $path = join '', $first, map ucfirst, @remaining;
        }
        elsif (defined $param and $casing eq 'camelcase') {
            my ($first, @remaining) = split /_/, $path;
            $path = join '', $first, map ucfirst, @remaining;
        }
        elsif (defined $param and $casing eq 'pascalcase') {
            $path = join '', map ucfirst, split /_/, $path;
        }
        elsif (defined $param and $casing eq 'uppercase') {
            $path = uc $path;
        }

        push @results, $path, defined $param ? $param : ();
    }

    # return new resource instance dynamically
    return $self->resource($method, @results);

}

# CONSTRUCTION

method BUILD () {

    my $ident = $self->identifier;
    my $agent = $self->user_agent;

    # identify the API client
    $agent->transactor->name($ident);

    return $self;

}

# METHODS

method PREPARE ($ua, $tx, %args) {

    if (my $credentials = $self->credentials) {

        # process credentials
        $credentials->process($tx);

    }

    my $headers = $tx->req->headers;
    my $url     = $tx->req->url;

    # default headers
    $headers->header('Content-Type' => 'application/json');

    return $self;

}

method action ($method, %args) {

    $method = uc($method || 'get');

    # execute transaction and return response
    return $self->$method(%args);

}

method create (%args) {

    # execute transaction and return response
    return $self->POST(%args);

}

method delete (%args) {

    # execute transaction and return response
    return $self->DELETE(%args);

}

method fetch (%args) {

    # execute transaction and return response
    return $self->GET(%args);

}

method resource (@segments) {

    my $class = ref($self);

    # build new resource instance
    my $instance = $class->new(
        debug      => $self->debug,
        fatal      => $self->fatal,
        retries    => $self->retries,
        timeout    => $self->timeout,
        user_agent => $self->user_agent,
        identifier => $self->identifier,
        version    => $self->version,
        # attempt to deduce other attributes
        %$self
    );

    # resource locator
    my $url = $instance->url;

    # modify resource locator if possible
    $url->path(join '/', $self->url->path, @segments);

    # return resource instance
    return $instance;

}

method update (%args) {

    # execute transaction and return response
    return $self->PUT(%args);

}

1;

__END__