abonbot/lib/darsan_client.pm

#!/usr/bin/perl

use Modern::Perl;

# Клиент для Дарсана, версия 2
# Ю. Жиловец, 17.02.2015

package darsan_client;

use Mojo::UserAgent;
use URI::Query;
use Mojo::JSON qw/j/;
use Data::Dumper;
use utf8;

sub new
{
  my $class = shift;
  my $auth = shift;
  my $tpl = shift;

  return bless {auth=>$auth,tpl=>$tpl,error=>undef, ua => new Mojo::UserAgent}, $class;
}

sub source_ip
{
  my $self = shift;
  my $ip = shift;
  $self->{ua}->local_address($ip);
}

sub error
{
  return $_[0]->{error};
}

sub _query
{
  my $self = shift;
  my $method = shift;
  my $url = shift;
  my $sub = pop;
  my @rest = @_;

  undef $self->{error};

  my $is_raw = 0;
  if ($method eq "GET_RAW")
  {
    $method = "GET";
    $is_raw = 1;
  }

  my $headers = {};
  $headers = shift(@rest) if @rest && ref($rest[0]) eq "HASH";

   my $make_query = sub
   {
      my $token = shift;  
      $headers->{Authorization} = "Darsan2 $token";
      return $self->{ua}->build_tx($method,$url,$headers,@rest);
   };

  if ($sub && $sub eq "promise")
  {
    return $self->_promise_query($make_query, $is_raw);
  }
  elsif ($sub)
  {
    return $self->_async_query($sub, $make_query, $is_raw);
  }
  else
  {
    return $self->_sync_query($make_query, $is_raw);
  }
}

sub _sync_query
{
  my $self = shift;
  my $make_query = shift;
  my $is_raw = shift;
  
  my $token = $self->{auth}->token;
  if ($self->{auth}->error)
  {
    $self->{error} = "darsan_auth: ".$self->{auth}->error;
    return undef;
  }

  my $tx = $self->{ua}->start($make_query->($token));
  my $resp = $tx->result;

 if ($resp->is_error)
 {
    my $e = $tx->error; 
    $e->{code} ||= 500;
    $self->{error} = "$e->{code} $e->{message}/".substr($tx->res->body,0,500);
    return undef;
  }

  return $resp if $is_raw;
  return $resp->headers->content_type =~ m|application/json| ? j($resp->body) : $resp->body;
}

sub _async_query
{
  my $self = shift;
  my $sub = shift;
  my $make_query = shift;
  my $is_raw = shift;
  
  $self->{auth}->token(sub 
  {
      my ($err,$token) = @_;
      return $sub->({code=>500, message=>"darsan_auth: cannot get token: $err->{message}"}) if $err;

      my $tx = $self->{ua}->start($make_query->($token) => sub
      { 
        my ($ua, $tx) = @_;
        my $resp = $tx->result;
      
        if ($resp->is_error)
        {
          my $e = $tx->error;
          $e->{code} ||= 500;
          my $error = { code=>$e->{code}, message=>$e->{message}, response=>$tx->res };
          return $sub->($error);
        }
        
        $sub->(undef,$is_raw ? $resp : j($resp->body));
      });
  });
}

sub _promise_query
{
  my $self = shift;
  my $make_query = shift;
  my $is_raw = shift;
  
  return $self->{auth}->token("promise")->then(sub
  {
      my $token = shift;

      my $tx = $self->{ua}->start_p($make_query->($token))->then(sub
      { 
        my $tx = shift;
        my $resp = $tx->result;
        
        if ($resp->is_success)
        {
           $is_raw ? $resp : j($resp->body);
        }
        else
        {
          my $body = $resp->body;
          utf8::decode($body);
          die {code=>$resp->{code}, message=>$resp->{message}, body=>$body, content_type=>$resp->headers->header("Content-Type")};
        }
      });
  }, sub 
  {
    my $err = shift;
    die {code=>500, message=>"darsan_auth: cannot get token from $err->{url}: $err->{code} $err->{message}"};
  });
}

sub get
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;
  
  my $q = URI::Query->new($params);
  $q = "?$q" if $q;
  my $url = $self->_make_server($topic).$path.$q;
  return $self->_query(GET => $url => $sub);
}

sub get_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};

  return $self->get($topic, $path, $params, "promise");
}

sub get_raw
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;
            
  my $q = URI::Query->new($params);
  $q = "?$q" if $q;
  my $url = $self->_make_server($topic).$path.$q;
  return $self->_query(GET_RAW => $url => $sub);
}

sub get_raw_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
            
  return $self->get_raw($topic, $path, $params, "promise");            
}

sub post
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;
  
  my $url = $self->_make_server($topic).$path;
  return $self->_query(POST => $url => form => $params => $sub);
}

sub post_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};

  return $self->post($topic, $path, $params, "promise");  
}

sub post_json
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;
  
  my $url = $self->_make_server($topic).$path;
  return $self->_query(POST => $url => { "Content-Type"=>"application/json" } => j($params) => $sub);
}

sub post_json_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  
  my $url = $self->_make_server($topic).$path;
  return $self->_query(POST => $url => { "Content-Type"=>"application/json" } => j($params) => "promise");
}

sub delete
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;

  my $url = $self->_make_server($topic).$path;
  return $self->_query(DELETE => $url => form => $params => $sub);
}

sub delete_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};

  $self->delete($topic, $path, $params, "promise");  
}

sub put
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;
  
  my $url = $self->_make_server($topic).$path;
  return $self->_query(PUT => $url => form => $params => $sub);
}

sub put_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};

  $self->put_p($topic, $path, $params, "promise");  
}

sub patch
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;

  my $url = $self->_make_server($topic).$path;
  return $self->_query(PATCH => $url => form => $params => $sub);
}

sub patch_json
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};
  my $sub = shift;

  my $url = $self->_make_server($topic).$path;
  return $self->_query(PATCH => $url => { "Content-Type"=>"application/json" } => j($params) => $sub);
}

sub patch_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};

  $self->patch($topic, $path, $params, "promise");  
}

sub patch_json_p
{
  my $self = shift;
  my $topic = shift;
  my $path = shift;
  my $params = shift || {};

  $self->patch_json($topic, $path, $params, "promise");  
}

sub map
{
  my $self = shift;
  my $map = shift;
  $self->{map} = $map;
}

sub _make_server
{
  my $self = shift;
  my $topic = shift;

  return $self->{map}->{$topic} if $self->{map} && exists $self->{map}->{$topic};

  my $server = $self->{tpl};
  $server =~ s/\{entity\}/$topic/;
  $server =~ s/darsan-darsan/darsan/;

  return $server;
}

1;