#!/usr/bin/perl use Modern::Perl; # Клиент для Дарсана, версия 2 # Ю. Жиловец, 17.02.2015 # Версия 3 # Ю. Жиловец, 1.05.2023 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 $is_promise = shift; my $method = shift; my @args = @_; undef $self->{error}; my $is_raw = 0; if ($method eq "GET_RAW") { $method = "GET"; $is_raw = 1; } my $tx = $self->{ua}->build_tx($method, @args); if ($is_promise) { return $self->_promise_query($tx, $is_raw); } else { return $self->_sync_query($tx, $is_raw); } } sub _sync_query { my $self = shift; my $tx = shift; my $is_raw = shift; my $token = $self->{auth}->token; if ($self->{auth}->error) { $self->{error} = $self->{auth}->error; return undef; } $tx->req->headers->authorization("Darsan2 $token"); $tx = $self->{ua}->start($tx); my ($error, $body) = $self->_parse_reply($tx); if ($error) { $self->{error} = $error; return undef; } return $is_raw ? $tx->result : $body; } sub _promise_query { my $self = shift; my $tx = shift; my $is_raw = shift; return $self->{auth}->token_p->then(sub { my $token = shift; $tx->req->headers->authorization("Darsan2 $token"); $self->{ua}->start_p($tx) })->catch(sub { my $err = shift; die $err if ref $err; die {code=>500, body=>"", url=>$tx->req->url."", message=>$err}; }) ->then(sub { my $tx = shift; my ($error, $body) = $self->_parse_reply($tx); die $error if $error; return $is_raw ? $tx->result : $body; }); } sub _parse_reply { my $self = shift; my $tx = shift; my $body = $tx->res->body; my $cont = $tx->res->headers->content_type; $body = j($body) if $cont && ($cont =~ m|^application/json| || $cont =~ m|^application/error\+json|); if (my $e = $tx->error) { $e->{code} ||= 500; my $err = {url=>$tx->req->url."", code=>$e->{code}, message=>$e->{message}, body=>$body}; return ($err); } return (undef, $body); } sub get { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $q = URI::Query->new($params); $q = "?$q" if $q; my $url = $self->_make_server($topic).$path.$q; return $self->_query(0, GET => $url); } sub get_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $q = URI::Query->new($params); $q = "?$q" if $q; my $url = $self->_make_server($topic).$path.$q; return $self->_query(1, GET => $url); } sub get_raw { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $q = URI::Query->new($params); $q = "?$q" if $q; my $url = $self->_make_server($topic).$path.$q; return $self->_query(0, GET_RAW => $url); } sub get_raw_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $q = URI::Query->new($params); $q = "?$q" if $q; my $url = $self->_make_server($topic).$path.$q; return $self->_query(1, GET_RAW => $url); } sub post { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, POST => $url => form => $params); } sub post_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(1, POST => $url => form => $params); } sub post_json { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, POST => $url => { "Content-Type"=>"application/json" } => j($params)); } 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(1, POST => $url => { "Content-Type"=>"application/json" } => j($params)); } sub delete { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, DELETE => $url => form => $params); } sub delete_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(1, DELETE => $url => form => $params); } sub put { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, PUT => $url => form => $params); } sub put_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(1, PUT => $url => form => $params); } sub put_json { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, PUT => $url => { "Content-Type"=>"application/json" } => j($params)); } sub put_json_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(1, PUT => $url => { "Content-Type"=>"application/json" } => j($params)); } sub patch { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, PATCH => $url => form => $params); } sub patch_json { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(0, PATCH => $url => { "Content-Type"=>"application/json" } => j($params)); } sub patch_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(1, PATCH => $url => form => $params); } sub patch_json_p { my $self = shift; my $topic = shift; my $path = shift; my $params = shift || {}; my $url = $self->_make_server($topic).$path; return $self->_query(1, PATCH => $url => { "Content-Type"=>"application/json" } => j($params)); } 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; } sub clone { my $self = shift; return bless { %$self }, "darsan_client"; } sub auth { my $self = shift; my $auth = shift; $self->{auth} = $auth; return $self; } 1;