File Coverage

blib/lib/Clustericious/Client.pm

Criterion	Covered	Total	%
statement	194	368	52.7
branch	46	168	27.3
condition	24	99	24.2
subroutine	33	54	61.1
pod	15	15	100.0
total	312	704	44.3

package Clustericious::Client;

use strict; no strict 'refs';
use warnings;

# ABSTRACT: Construct command line and perl clients for RESTful services.
our $VERSION = '0.85'; # VERSION


use Mojo::Base qw/-base/;

use Mojo::UserAgent;
use Mojo::ByteStream qw/b/;
use Mojo::Parameters;
use JSON::XS;
use Clustericious::Config;
use Clustericious::Client::Object;
use Clustericious::Client::Meta;
use Clustericious::Client::Meta::Route;
use MojoX::Log::Log4perl;
use Log::Log4perl qw/:easy/;
use File::Temp;


has server_url => '';
has [qw(tx res userinfo client)];
has _remote => ''; # Access via remote()
has _cache => sub { + {} }; # cache of credentials

sub import
{
    my $class = shift;
    my $caller = caller;

    {
    no strict 'refs';
    push @{"${caller}::ISA"}, $class unless $caller->isa($class);
    *{"${caller}::route"} = \&route;
    *{"${caller}::route_meta"} = \&route_meta;
    *{"${caller}::route_args"} = \&route_args;
    *{"${caller}::route_doc"} = sub {
        Clustericious::Client::Meta->add_route( $caller, @_ )
    };
    *{"${caller}::object"} = \&object;
    *{"${caller}::import"} = sub {};
    }
}


sub new
{
    my $self = shift->SUPER::new(@_);
    my %args = @_;

    if ($self->{app})
    {
        my $app = $self->{app};
        $app = $app->new() unless ref($app);
        my $client = Mojo::UserAgent->new;
        return undef unless $client;
        eval { $client->server->app($app) } // $client->app($app);

        $self->client($client);
    }
    else
    {
        $self->client(Mojo::UserAgent->new);
        if (not length $self->server_url)
        {
            my $url = $self->_config->url;
            $url =~ s{/$}{};
            $self->server_url($url);
        }
    }

    $self->client->inactivity_timeout($ENV{CLUSTERICIOUS_KEEP_ALIVE_TIMEOUT} || 300);

    return $self;
}



sub remote {
    my $self = shift;
    return $self->_remote unless @_ > 0;
    my $remote = shift;
    unless ($remote) { # reset to default
        $self->{_remote} = '';
        $self->server_url($self->_config->url);
        return;
    }
    my $info = $self->_base_config->remotes->$remote;
    TRACE "Using remote url : ".$info->{url};
    $self->server_url($info->{url});
    $self->userinfo('');
    $self->_remote($remote);
}


sub remotes {
    my $self = shift;
    my %found = $self->_base_config->remotes(default => {});
    return keys %found;
}


sub login {
    my $self = shift;
    my %args = @_;
    my ($user,$pw) =
           @_==2 ? @_
         : @_    ?  @args{qw/username password/}
         : map $self->_config->$_, qw/username password/;
    $self->userinfo(join ':', $user,$pw);
}


sub errorstring {
    my $self = shift;
    WARN "Missing response in client object" unless $self->res;
    return unless $self->res;
    return if $self->res->code && $self->res->is_status_class(200);
    $self->res->error
      || sprintf( "(%d) %s", $self->res->code, $self->res->message );
}


sub has_error {
    my $c = shift;
    return unless $c->tx || $c->res;
    return 1 if $c->tx && $c->tx->error;
    return 1 if $c->res && !$c->res->is_status_class(200);
    return 0;
}



sub route {
    my $subname = shift;
    my $objclass = ref $_[0] eq 'ARRAY' ? shift->[0] : undef;
    my $doc      = ref $_[-1] eq 'SCALAR' ? ${ pop() } : "";
    my $url      = pop || "/$subname";
    my $method   = shift || 'GET';

    my $client_class = scalar caller();
    my $meta = Clustericious::Client::Meta::Route->new(
            client_class => scalar caller(),
            route_name => $subname
    );

    $meta->set(method => $method);
    $meta->set(url    => $url);
    $meta->set_doc($doc);

    if ($objclass) {
        eval "require $objclass";
        if ($@) {
            LOGDIE "Error loading $objclass : $@" unless $@ =~ /Can't locate/i;
        }
    }

    {
        no strict 'refs';
        *{caller() . "::$subname"} = sub {
            my $self = shift;
            my @args = $self->meta_for($subname)->process_args(@_);
            my $got = $self->_doit($meta,$method,$url,@args);
            return $objclass->new($got, $self) if $objclass;
            return $got;
        };
    }

}


sub route_meta {
    my $name = shift;
    my $attrs = shift;
    my $meta = Clustericious::Client::Meta::Route->new(
        client_class => scalar caller(),
        route_name   => $name
    );

    $meta->set($_ => $attrs->{$_}) for keys %$attrs;
}


sub route_args {
    my $name = shift;
    my $args = shift;
    die "args must be an array ref" unless ref $args eq 'ARRAY';
    my $meta = Clustericious::Client::Meta::Route->new(
        client_class => scalar caller(),
        route_name   => $name
    );

    $meta->set(args => $args);
}


sub object {
    my $objname = shift;
    my $url     = shift || "/$objname";
    my $doc     = ref $_[-1] eq 'SCALAR' ? ${ pop() } : '';
    my $caller  = caller;

    my $objclass = "${caller}::" .
        join('', map { ucfirst } split('_', $objname)); # foo_bar => FooBar

    eval "require $objclass";
    if ($@) {
        LOGDIE "Error loading $objclass : $@" unless $@ =~ /Can't locate/i;
    }

    $objclass = 'Clustericious::Client::Object' unless $objclass->can('new');

    Clustericious::Client::Meta->add_object(scalar caller(),$objname,$doc);

    no strict 'refs';
    *{"${caller}::$objname"} = sub {
        my $self = shift;
        my $meta = Clustericious::Client::Meta::Route->new(
            client_class => $caller,
            route_name   => $objname
        );
        $meta->set( quiet_post => 1 );
        my $data = $self->_doit( $meta, GET => $url, @_ );
        $objclass->new( $data, $self );
    };
    *{"${caller}::${objname}_delete"} = sub {
        my $meta = Clustericious::Client::Meta::Route->new(
            client_class => $caller,
            route_name   => $objname.'_delete',
        );
        $meta->set(dont_read_files => 1);
        shift->_doit( $meta, DELETE => $url, @_ );
    };
    *{"${caller}::${objname}_search"} = sub {
        my $meta = Clustericious::Client::Meta::Route->new(
            client_class => $caller,
            route_name   => $objname.'_search'
        );
        $meta->set(dont_read_files => 1);
        shift->_doit( $meta, POST => "$url/search", @_ );
    };
}

sub _doit {
    my $self = shift;
    my $meta;
    $meta = shift if ref $_[0] eq 'Clustericious::Client::Meta::Route';
    my ($method, $url, @args) = @_;

    my $auto_failover;
    $auto_failover = 1 if $meta && $meta->get('auto_failover');

    $url = $self->server_url . $url if $self->server_url && $url !~ /^http/;
    return undef if $self->server_url eq 'http://0.0.0.0';

    my $cb;
    my $body = '';
    my $headers = {};

    if ($method eq 'POST' && grep /^--/, @args) {
        s/^--// for @args;
        @args = ( { @args } );
    }

    $url = Mojo::URL->new($url) unless ref $url;
    my $parameters = $url->query;

    # Set up mappings from parameter names to modifier callbacks.
    my %url_modifier;
    my %payload_modifer;
    my %gen_url_modifier = (
        query  => sub { my $name = shift;
            sub { my ($u,$v) = @_; $u->query({$name => $v}) }  },
        append => sub { my $name = shift;
            sub { my ($u,$v) = @_; push @{ $u->path->parts } , $v; $u; } },
    );
    my %gen_payload_modifier = (
        array => sub {
            my ( $name, $key ) = @_;
            LOGDIE "missing key for array payload modifier" unless $key;
            sub { my $body = shift; $body ||= {}; push @{ $body->{$key} }, ( $name => shift ); $body; }
        },
        hash => sub {
            my $name = shift;
            sub { my $body = shift; $body ||= {}; $body->{$name} = shift; $body; }
        },
    );
    if ($meta && (my $arg_spec = $meta->get('args'))) {
        for (@$arg_spec) {
            my $name = $_->{name};
            if (my $modifies_url = $_->{modifies_url}) {
                $url_modifier{$name} =
                    ref($modifies_url) eq 'CODE'            ? $modifies_url
                 :  ($a = $gen_url_modifier{$modifies_url}) ? $a->($name)
                 :  die "don't understand how to interpret modifies_url=$modifies_url";
            }
            if (my $modifies_payload = $_->{modifies_payload}) {
                 $payload_modifer{$name} =
                    ref($modifies_payload) eq 'CODE' ? $modifies_payload
                 : ($a = $gen_payload_modifier{$modifies_payload}) ? $a->($name,$_->{key})
                 : LOGDIE "don't understand how to interpret modifies_payload=$modifies_payload";
            }
        }
    }

    while (defined(my $arg = shift @args)) {
        if (ref $arg eq 'HASH') {
            $method = 'POST';
            $parameters->append(skip_existing => 1) if $meta && $meta->get("skip_existing");
            $body = encode_json $arg;
            $headers = { 'Content-Type' => 'application/json' };
        } elsif (ref $arg eq 'CODE') {
            $cb = $self->_mycallback($arg);
        } elsif (my $code = $url_modifier{$arg}) {
            $url = $code->($url, shift @args);
        } elsif (my $code2 = $payload_modifer{$arg}) {
            $body = $code2->($body, shift @args);
        } elsif ($method eq "GET" && $arg =~ s/^--//) {
            my $value = shift @args;
            $parameters->append($arg => $value);
        } elsif ($method eq "GET" && $arg =~ s/^-//) {
            # example: $client->esdt(-range => [1 => 100]);
            my $value = shift @args;
            if (ref $value eq 'ARRAY') {
                $value = "items=$value->[0]-$value->[1]";
            }
            $headers->{$arg} = $value;
        } elsif ($method eq "POST" && !ref $arg) {
            $body = $arg;
            $headers = shift @args if $args[0] && ref $args[0] eq 'HASH';
        } else {
            push @{ $url->path->parts }, $arg;
        }
    }
    $url = $url->to_abs unless $url->is_abs;
    WARN "url $url is not absolute" unless $url =~ /^http/i || $ENV{HARNESS_ACTIVE};

    $url->userinfo($self->userinfo) if $self->userinfo;

    DEBUG ( (ref $self)." : $method " ._sanitize_url($url));
    $headers->{Connection} ||= 'Close';
    $headers->{Accept}     ||= 'application/json';

    if($body && ref $body eq 'HASH' || ref $body eq 'ARRAY')
    {
        $headers->{'Content-Type'} = 'application/json';
        $body = encode_json $body;
    }

    return $self->client->build_tx($method, $url, $headers, $body, $cb) if $cb;

    my $tx = $self->client->build_tx($method, $url, $headers, $body);

    $tx = $self->client->start($tx);
    my $res = $tx->res;
    $self->res($res);
    $self->tx($tx);

    my $auth_header;
    if (($tx->res->code||0) == 401 && ($auth_header = $tx->res->headers->www_authenticate)
        && !$url->userinfo && ($self->_has_auth || $self->_can_auth)) {
        DEBUG "received code 401, trying again with credentials";
        my ($realm) = $auth_header =~ /realm=(.*)$/i;
        my $host = $url->host;
        $self->login( $self->_has_auth ? () : $self->_get_user_pw($host,$realm) );
        return $self->_doit($meta ? $meta : (), @_);
    }

    if ($res->is_status_class(200)) {
        TRACE "Got response : ".$res->to_string;
        my $content_type = $res->headers->content_type || do {
            WARN "No content-type from "._sanitize_url($url);
            "text/plain";
        };
        return $method =~ /HEAD|DELETE/       ? 1
            : $content_type =~ qr[application/json] ? decode_json($res->body)
            : $res->body;
    }

    # Failed.
    my ($msg,$code) = $tx->error;
    $msg ||= 'unknown error';
    my $s_url = _sanitize_url($url);

    if ($code) {
        if ($code == 404) {
            TRACE "$method $url : $code $msg"
                 unless $ENV{ACPS_SUPPRESS_404}
                     && $url =~ /$ENV{ACPS_SUPPRESS_404}/;
        } else {
            ERROR "Error trying to $method $s_url : $code $msg";
            TRACE "Full error body : ".$res->body if $res->body;
            my $brief = $res->body || '';
            $brief =~ s/\n/ /g;
            ERROR substr($brief,0,200) if $brief;
        }
        # No failover for legitimate status codes.
        return undef;
    }

    unless ($auto_failover) {
        ERROR "Error trying to $method $s_url : $msg";
        ERROR $res->body if $res->body;
        return undef;
    }
    my $failover_urls = $self->_config->failover_urls(default => []);
    unless (@$failover_urls) {
        ERROR $msg;
        return undef;
    }
    INFO "$msg but will try up to ".@$failover_urls." failover urls";
    TRACE "Failover urls : @$failover_urls";
    for my $url (@$failover_urls) {
        DEBUG "Trying $url";
        $self->server_url($url);
        my $got = $self->_doit(@_);
        return $got if $got;
    }

    return undef;
}

sub _mycallback
{
    my $self = shift;
    my $cb = shift;
    sub
    {
        my ($client, $tx) = @_;

        $self->res($tx->res);
        $self->tx($tx);

        if ($tx->res->is_status_class(200))
        {
            my $body = $tx->res->headers->content_type =~ qr[application/json]
                ? decode_json($tx->res->body) : $tx->res->body;

            $cb->($body ? $body : 1);
        }
        else
        {
            $cb->();
        }
    }
}

sub _sanitize_url {
    # Remove passwords from urls for displaying
    my $url = shift;
    $url = Mojo::URL->new($url) unless ref $url eq "Mojo::URL";
    return $url unless $url->userinfo;
    my $c = $url->clone;
    $c->userinfo("user:*****");
    return $c;
}

sub _appname {
    my $self = shift;
    (my $appname = ref $self) =~ s/:.*$//;
    return $appname;
}

sub _config {
    my $self = shift;
    my $conf = $self->_base_config;
    if (my $remote = $self->_remote) {
        return $conf->remotes->$remote;
    }
    return $conf;
}

sub _base_config {
    # Independent of remotes
    my $self = shift;
    return $self->{_base_config} if defined($self->{_base_config});
    $self->{_base_config} = Clustericious::Config->new($self->_appname);
    return $self->{_base_config};
}

sub _has_auth {
    my $self = shift;
    return 0 unless $self->_config->username(default => '');
    return 0 unless $self->_config->password(default => '');
    return 1;
}

sub _can_auth {
    my $self = shift;
    return -t STDIN ? 1 : 0;
}

sub _get_user_pw  {
    my $self = shift;
    my $host = shift;
    my $realm = shift;
    $realm = '' unless defined $realm;
    return @{ $self->_cache->{$host}{$realm} } if exists($self->_cache->{$host}{$realm});
    # "use"ing causes too many warnings; load on demand.
    require Term::Prompt;
    my $user = Term::Prompt::prompt('x', "Username for $realm at $host : ", '', $ENV{USER} // $ENV{USERNAME});
    my $pw = Term::Prompt::prompt('p', 'Password:', '', '');
    $self->_cache->{$host}{$realm} = [ $user, $pw ];
    return ($user,$pw);
}


sub meta_for {
    my $self = shift;
    my $route_name = shift || [ caller 1 ]->[3];
    if ( $route_name =~ /::([^:]+)$/ ){
        $route_name = $1;
    }
    my $meta = Clustericious::Client::Meta::Route->new(
        route_name   => $route_name,
        client_class => ref $self
    );
}


sub version {
    my $self = shift;
    my $meta = $self->meta_for("version");
    $meta->set(auto_failover => 1);
    $self->_doit($meta, GET => '/version');
}


sub status {
    my $self = shift;
    my $meta = $self->meta_for("status");
    $meta->set(auto_failover => 1);
    $self->_doit($meta, GET => '/status');
}


sub api {
    my $self = shift;
    my $meta = $self->meta_for("api");
    $meta->set( auto_failover => 1 );
    $self->_doit( $meta, GET => '/api' );
}


sub logtail {
    my $self = shift;
    my $got = $self->_doit(GET => '/log', @_);
    return { text => $got };
}


1;

__END__