File Coverage

blib/lib/App/Docker/Client.pm

Criterion	Covered	Total	%
statement	54	107	50.4
branch	10	36	27.7
condition	7	14	50.0
subroutine	17	27	62.9
pod	15	15	100.0
total	103	199	51.7

package App::Docker::Client;

=head1 NAME

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

=head1 VERSION

Version 0.010200

=cut

our $VERSION = '0.010200';

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

=head2 with_valid_code

=cut

sub with_valid_code {
    my ( $self, $code ) = @_;
    return if $code !~ m/^(\d{3})$/;
    $self->{_valid_codes}->{$code} = 1;
    return $self;
}

=head2 without_valid_code

=cut

sub without_valid_code {
    my ( $self, $code ) = @_;
    return if $code !~ m/^(\d{3})$/;
    $self->{_valid_codes}->{$code} = 0;
    return $self;
}

=head2 show_progress

=cut

sub show_progress {
    my ( $self, $show_progress ) = @_;
    $self->{show_progress} = $show_progress ? $show_progress == 0 ? () : 1 : 1;
    return $self;
}

=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 ssl_opts

Getter/Setter for internal hash key ssl_opts.

=cut

sub ssl_opts {
    return $_[0]->{ssl_opts} unless $_[1];
    $_[0]->{ssl_opts} = $_[1];
    return $_[0]->{ssl_opts};
}

=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(
        (
            $self->{show_progress} ? ( show_progress => 1 ) : (),
            $self->ssl_opts ? ( ssl_opts => $self->ssl_opts ) : (),
        )
    );
    return $self->{UserAgent};

}

=head2 get

=cut

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

=head2 delete

=cut

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

=head2 request

=cut

sub request {
    my ( $self, $request, $callback ) = @_;
    return $self->_hande_response( $self->user_agent->request( $request, $callback ) );
}

=head2 post

=cut

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

=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 to_hashref

Getter/Setter for internal hash key ua.

=cut

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

{

=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 _hande_response

=cut

    sub _hande_response {
        my ( $self, $response ) = @_;
        $self->_error_code( $response->code, $response->message, $response->content );
        my $content = $response->content();
        return $self->to_hashref($content);
    }

=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 $code if $self->{_valid_codes}->{$code};
        require Carp;
        Carp::cluck;
        Carp::croak "FAILURE: $code - " . qq~$message\n$content~;
    }
}

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

__END__