File Coverage

blib/lib/App/Docker/Client.pm

Criterion	Covered	Total	%
statement	52	90	57.7
branch	10	22	45.4
condition	7	14	50.0
subroutine	16	22	72.7
pod	10	10	100.0
total	95	158	60.1

package App::Docker::Client;

=head1 NAME

App::Docker::Client - Simple and plain Docker client!

=head1 VERSION

Version 0.010100

=cut

our $VERSION = '0.010100';

use 5.16.0;
use strict;
use warnings;
use LWP::UserAgent;
use JSON;
use LWP::Protocol::http::SocketUnixAlt;

=head2 new

Constructor

=cut

sub new {
    my $class = shift;
    my $self  = {@_};
    $self->{_scheme_postfixes} = { file => ':', http => '://', https => '://', };
    $self->{_valid_codes}      = { 200  => 1,   201  => 1,     204   => 1 };
    bless $self, $class;
    return $self;
}

=head1 SUBROUTINES/METHODS

=cut

=head2 authority

Getter/Setter for internal hash key authority.
=cut

sub authority {
    return $_[0]->{authority} || '/var/run/docker.sock' unless $_[1];
    $_[0]->{authority} = $_[1] || '/var/run/docker.sock';
    return $_[0]->{authority};
}

=head2 scheme

Getter/Setter for internal hash key scheme.
=cut

sub scheme {
    return $_[0]->{scheme} || 'http' unless $_[1];
    $_[0]->{scheme} = $_[1] || 'http';
    return $_[0]->{scheme};
}

=head2 json

Getter/Setter for internal hash key json.
=cut

sub json {
    return $_[0]->{json} || JSON->new->utf8() unless $_[1];
    $_[0]->{json} = $_[1] || JSON->new->utf8();
    return $_[0]->{json};
}

=head2 user_agent

Getter/Setter for internal hash key UserAgent.

=cut

sub user_agent {
    my ( $self, $user_agent ) = @_;
    if ($user_agent) {
        $self->{UserAgent} = $user_agent;
        return $self->{UserAgent};
    }
    return $self->{UserAgent} if $self->{UserAgent};

    if ( -S $self->authority() ) {
        LWP::Protocol::implementor( http => 'LWP::Protocol::http::SocketUnixAlt' );
    }
    $self->{UserAgent} = LWP::UserAgent->new();
    return $self->{UserAgent};

}

=head2 get



=cut

sub get {
    my ( $self, $path, $options ) = @_;
    return $self->_to_hashref( $self->user_agent->get( $self->uri( $path, %$options ) ) );
}

=head2 delete



=cut

sub delete {
    my ( $self, $path, $options ) = @_;
    return $self->_to_hashref( $self->user_agent->delete( $self->uri( $path, %$options ) ) );
}


=head2 request

=cut

sub request { $_[0]->_to_hashref( $_[0]->user_agent->request( $_[1] ) ) }

=head2 post

=cut

sub post {
    my ( $self, $path, $query, $body, $options ) = @_;
    return $self->request( $self->_http_request( $path, $query ) ) unless $body;
    return $self->request( $self->_handle_json( $path, $query, $body ) ) unless ($options);
    return $self->request( $self->_handle_custom( $path, $query, $body, $options ) );
}

=head2 uri

Creating a new URI object.

Internal varibales:

 * scheme

 * authority

Given varibales:

 * path

 * query options

=cut

sub uri {
    my ( $self, $path, %opts ) = @_;
    require URI;
    my $uri =
      URI->new( $self->scheme()
          . $self->{_scheme_postfixes}->{ lc $self->scheme() }
          . $self->authority() . '/'
          . $path );
    $uri->query_form(%opts);
    return $uri;
}

{

=head2 post

=cut

    sub _handle_json {
        my ( $self, $path, $query, $body ) = @_;
        my $req = $self->_http_request( $path, $query );
        $req->content_type('application/json');
        my $json = $self->json->encode($body);
        $json =~ s/"(false|true)"/$1/g;
        $req->content($json);
        return $req;
    }

=head2 post

=cut

    sub _handle_custom {
        my ( $self, $path, $query, $body, $options ) = @_;
        my $req = $self->_http_request( $path, $query );
        $req->content_type( $options->{content_type} );
        $req->content_length(
            do { use bytes; length $body }
        );
        $req->content($body);
        return $req;
    }

=head2 _http_request

create HTTP::Request by uri params

=cut

    sub _http_request {
        my ( $self, $path, $query ) = @_;
        require HTTP::Request;
        return HTTP::Request->new( POST => $self->uri( $path, %$query ) );
    }

=head2 _to_hashref

Getter/Setter for internal hash key ua.

=cut

    sub _to_hashref {
        my ( $self, $response ) = @_;
        $self->_error_code( $response->code, $response->message, $response->content );
        my $content = $response->content();
        return if !$content;
        my $data = eval { $self->json->decode($content) };
        return $@ ? $content : $data;
        require Carp;
        Carp::cluck;
        Carp::croak "JSON ERROR: $@";
    }

=head2 _error_code

Simple error handler returns undef if everything is ok dies on error.

=cut

    sub _error_code {
        my ( $self, $code, $message, $content ) = @_;
        return if $self->{_valid_codes}->{$code};
        require Carp;
        Carp::cluck;
        Carp::croak "FAILURE: $code - " . qq~$message\n$content~;
    }
}

1;    # End of App::Docker::Client

__END__