| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381 |
- #!/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;
|