view release on metacpan or  search on metacpan

lib/Respite/Client.pm  view on Meta::CPAN

package Respite::Client;

# Respite::Client - Generic class for running remote services

use strict;
use warnings;
use base 'Respite::Common'; # Default _configs
use IO::Socket::SSL ();
use Time::HiRes qw(sleep);
use Digest::MD5 qw(md5_hex);

BEGIN {
    if (! eval { require Throw }) {
        *Throw_::TO_JSON = sub { +{%{$_[0]}} };
        *Throw_::_str = sub { my ($s) = @_; my ($e,$p) = delete(@$s{qw(error _pretty)}); $e||="throw"; $e .= ': '.($p||$Throw::pretty?jsop():json())->encode($s) if %$s; "$e\n" };
        *throw = *Throw_::throw = sub { my ($m,$a,$l)=@_; $a=ref($m) ? $m : {%{$a||{}}, error => $m};
            do {my$i=$l||0;$i++while __PACKAGE__ eq caller$i; $a->{'trace'}=sprintf "%s at %s line %s\n",(caller$i)[3,1,2]} if $a->{'trace'}||$l; die bless $a, 'Throw_' };
         overload::OVERLOAD('Throw_', '""' => \&Throw_::_str, fallback => 1);
    } else { Throw->import('throw') }
}

sub service_name { $_[0]->{'service_name'} || $_[0]->{'service'} || throw "Missing service_name" }

sub run_method {
    my $self = shift;
    my $name   = $self->service_name;
    my $method = shift || throw "Missing $name service method", undef, 1;
    my $args   = shift || {};
    throw "Invalid $name service args", {method => $method, args => $args}, 1 if ref($args) ne 'HASH';
    local $args->{'_i'} = $self->{'remote_ip'}   || $ENV{'REMOTE_ADDR'} || (($ENV{'REALUSER'} || $ENV{'SUDO_USER'}) ? 'sudo' : 'cmdline');
    local $args->{'_w'} = $self->{'remote_user'} || $ENV{'REALUSER'} || $ENV{'SUDO_USER'} || $ENV{'REMOTE_USER'} || $ENV{'USER'} || (getpwuid($<))[0] || '-unknown-';
    local $args->{'_t'} = $self->{'token'} if !$args->{'_t'} && $self->{'token'};
    local $args->{'_c'} = do {my $i = my $c = 0; $c = [(caller $i++)[0..3]] while !$i || $c->[0]->isa(__PACKAGE__); join '; ', @$c} if ! $self->config(no_trace => undef, $name);
    local $self->{'flat'} = exists($args->{'_flat'}) ? delete($args->{'_flat'}) : $self->config(flat => undef, $name);
    return $self->_remote_call($method, $args) if $self->_needs_remote($method);
    return $self->_local_call( $method, $args);
}

sub _needs_remote {
    my ($self, $method) = @_;
    return $method !~ /(^local_|_local$)/;
}

sub _local_call {
    my ($self, $method, $args) = @_;
    my $name = $self->service_name;
    local $self->{'brand'} ||= $self->api_brand($name);
    my $hash = eval {
        my $code = $self->can("__$method") || throw "Invalid $name service method", {method => $method}, 1;
        return $code->($self, $args);
    } || (ref($@) eq 'HASH' && $@->{'error'} ? $@ : {error => "Trouble running $name service method", service => $name});
    return $self->_result({method => $method, args => $args, data => $hash, service => $name, url => 'local'});
}

sub config {
    my ($self, $key, $def, $name) = @_;
    $name ||= $self->service_name;
    my $c = $self->_configs($name);
    return exists($self->{$key}) ? $self->{$key}
        : exists($c->{"${name}_service_${key}"}) ? $c->{"${name}_service_${key}"}
        : (ref($c->{"${name}_service"}) && exists $c->{"${name}_service"}->{$key}) ? $c->{"${name}_service"}->{$key}
        : exists($c->{"${name}_${key}"}) ? $c->{"${name}_${key}"}
        : (ref($c->{$name}) && exists $c->{$name}->{$key}) ? $c->{$name}->{$key}
        : ref($def) eq 'CODE' ? $def->($self) : $def;
}

sub api_brand {
    my ($self, $name) = @_;
    $name ||= $self->service_name;
    return undef if $self->config(no_brand => undef, $name); ## no critic (ProhibitExplicitReturnUndef)
    $self->config(brand => sub { eval { config::provider() } || $self->_configs->{'provider'} || do { warn "Missing $name brand"; '-' } }, $name);
}

sub _remote_call {
    my ($self, $method, $args) = @_;
    my $begin  = Time::HiRes::time();
    my $name   = $self->service_name;
    my $brand  = $self->api_brand($name);
    my $val    = sub { my ($key, $def) = @_; $self->config($key, $def, $name) };
    my $no_ssl = $val->(no_ssl => undef);
    my $host   = $val->(host => sub {throw "Missing $name service host",undef,1});
    my $port   = $val->(port => ($no_ssl ? 80 : 443));
    my $path   = $val->(path => sub { $name =~ /^(\w+)_service/ ? $1 : $name });
    my $pass   = $val->(no_sign => undef) ? undef : $val->(pass => undef); # rely on the server to tell us if a password is necessary
    my $utf8   = exists($args->{'_utf8_encoded'}) ? delete($args->{'_utf8_encoded'}) : $val->(utf8_encoded => undef);
    my $enc    = $utf8 && (!ref($utf8) || $utf8->{$method});
    my $retry  = $val->(retry => undef);
    my $ns     = $val->(ns => undef);
    $method    = "${ns}_${method}" if $ns;
    my $url    = "/$path/$method".($brand ? "/$brand" : '');
    my $cookie = $val->(cookie => undef);