darsan_client.pm 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381
  1. #!/usr/bin/perl
  2. use Modern::Perl;
  3. # Клиент для Дарсана, версия 2
  4. # Ю. Жиловец, 17.02.2015
  5. # Версия 3
  6. # Ю. Жиловец, 1.05.2023
  7. package darsan_client;
  8. use Mojo::UserAgent;
  9. use URI::Query;
  10. use Mojo::JSON qw/j/;
  11. use Data::Dumper;
  12. use utf8;
  13. sub new
  14. {
  15. my $class = shift;
  16. my $auth = shift;
  17. my $tpl = shift;
  18. return bless {auth=>$auth,tpl=>$tpl,error=>undef, ua => new Mojo::UserAgent}, $class;
  19. }
  20. sub source_ip
  21. {
  22. my $self = shift;
  23. my $ip = shift;
  24. $self->{ua}->local_address($ip);
  25. }
  26. sub error
  27. {
  28. return $_[0]->{error};
  29. }
  30. sub _query
  31. {
  32. my $self = shift;
  33. my $is_promise = shift;
  34. my $method = shift;
  35. my @args = @_;
  36. undef $self->{error};
  37. my $is_raw = 0;
  38. if ($method eq "GET_RAW")
  39. {
  40. $method = "GET";
  41. $is_raw = 1;
  42. }
  43. my $tx = $self->{ua}->build_tx($method, @args);
  44. if ($is_promise)
  45. {
  46. return $self->_promise_query($tx, $is_raw);
  47. }
  48. else
  49. {
  50. return $self->_sync_query($tx, $is_raw);
  51. }
  52. }
  53. sub _sync_query
  54. {
  55. my $self = shift;
  56. my $tx = shift;
  57. my $is_raw = shift;
  58. my $token = $self->{auth}->token;
  59. if ($self->{auth}->error)
  60. {
  61. $self->{error} = $self->{auth}->error;
  62. return undef;
  63. }
  64. $tx->req->headers->authorization("Darsan2 $token");
  65. $tx = $self->{ua}->start($tx);
  66. my ($error, $body) = $self->_parse_reply($tx);
  67. if ($error)
  68. {
  69. $self->{error} = $error;
  70. return undef;
  71. }
  72. return $is_raw ? $tx->result : $body;
  73. }
  74. sub _promise_query
  75. {
  76. my $self = shift;
  77. my $tx = shift;
  78. my $is_raw = shift;
  79. return $self->{auth}->token_p->then(sub
  80. {
  81. my $token = shift;
  82. $tx->req->headers->authorization("Darsan2 $token");
  83. $self->{ua}->start_p($tx)
  84. })->catch(sub
  85. {
  86. my $err = shift;
  87. die $err if ref $err;
  88. die {code=>500, body=>"", url=>$tx->req->url."", message=>$err};
  89. })
  90. ->then(sub
  91. {
  92. my $tx = shift;
  93. my ($error, $body) = $self->_parse_reply($tx);
  94. die $error if $error;
  95. return $is_raw ? $tx->result : $body;
  96. });
  97. }
  98. sub _parse_reply
  99. {
  100. my $self = shift;
  101. my $tx = shift;
  102. my $body = $tx->res->body;
  103. my $cont = $tx->res->headers->content_type;
  104. $body = j($body) if $cont && ($cont =~ m|^application/json| || $cont =~ m|^application/error\+json|);
  105. if (my $e = $tx->error)
  106. {
  107. $e->{code} ||= 500;
  108. my $err = {url=>$tx->req->url."", code=>$e->{code}, message=>$e->{message}, body=>$body};
  109. return ($err);
  110. }
  111. return (undef, $body);
  112. }
  113. sub get
  114. {
  115. my $self = shift;
  116. my $topic = shift;
  117. my $path = shift;
  118. my $params = shift || {};
  119. my $q = URI::Query->new($params);
  120. $q = "?$q" if $q;
  121. my $url = $self->_make_server($topic).$path.$q;
  122. return $self->_query(0, GET => $url);
  123. }
  124. sub get_p
  125. {
  126. my $self = shift;
  127. my $topic = shift;
  128. my $path = shift;
  129. my $params = shift || {};
  130. my $q = URI::Query->new($params);
  131. $q = "?$q" if $q;
  132. my $url = $self->_make_server($topic).$path.$q;
  133. return $self->_query(1, GET => $url);
  134. }
  135. sub get_raw
  136. {
  137. my $self = shift;
  138. my $topic = shift;
  139. my $path = shift;
  140. my $params = shift || {};
  141. my $q = URI::Query->new($params);
  142. $q = "?$q" if $q;
  143. my $url = $self->_make_server($topic).$path.$q;
  144. return $self->_query(0, GET_RAW => $url);
  145. }
  146. sub get_raw_p
  147. {
  148. my $self = shift;
  149. my $topic = shift;
  150. my $path = shift;
  151. my $params = shift || {};
  152. my $q = URI::Query->new($params);
  153. $q = "?$q" if $q;
  154. my $url = $self->_make_server($topic).$path.$q;
  155. return $self->_query(1, GET_RAW => $url);
  156. }
  157. sub post
  158. {
  159. my $self = shift;
  160. my $topic = shift;
  161. my $path = shift;
  162. my $params = shift || {};
  163. my $url = $self->_make_server($topic).$path;
  164. return $self->_query(0, POST => $url => form => $params);
  165. }
  166. sub post_p
  167. {
  168. my $self = shift;
  169. my $topic = shift;
  170. my $path = shift;
  171. my $params = shift || {};
  172. my $url = $self->_make_server($topic).$path;
  173. return $self->_query(1, POST => $url => form => $params);
  174. }
  175. sub post_json
  176. {
  177. my $self = shift;
  178. my $topic = shift;
  179. my $path = shift;
  180. my $params = shift || {};
  181. my $url = $self->_make_server($topic).$path;
  182. return $self->_query(0, POST => $url => { "Content-Type"=>"application/json" } => j($params));
  183. }
  184. sub post_json_p
  185. {
  186. my $self = shift;
  187. my $topic = shift;
  188. my $path = shift;
  189. my $params = shift || {};
  190. my $url = $self->_make_server($topic).$path;
  191. return $self->_query(1, POST => $url => { "Content-Type"=>"application/json" } => j($params));
  192. }
  193. sub delete
  194. {
  195. my $self = shift;
  196. my $topic = shift;
  197. my $path = shift;
  198. my $params = shift || {};
  199. my $url = $self->_make_server($topic).$path;
  200. return $self->_query(0, DELETE => $url => form => $params);
  201. }
  202. sub delete_p
  203. {
  204. my $self = shift;
  205. my $topic = shift;
  206. my $path = shift;
  207. my $params = shift || {};
  208. my $url = $self->_make_server($topic).$path;
  209. return $self->_query(1, DELETE => $url => form => $params);
  210. }
  211. sub put
  212. {
  213. my $self = shift;
  214. my $topic = shift;
  215. my $path = shift;
  216. my $params = shift || {};
  217. my $url = $self->_make_server($topic).$path;
  218. return $self->_query(0, PUT => $url => form => $params);
  219. }
  220. sub put_p
  221. {
  222. my $self = shift;
  223. my $topic = shift;
  224. my $path = shift;
  225. my $params = shift || {};
  226. my $url = $self->_make_server($topic).$path;
  227. return $self->_query(1, PUT => $url => form => $params);
  228. }
  229. sub put_json
  230. {
  231. my $self = shift;
  232. my $topic = shift;
  233. my $path = shift;
  234. my $params = shift || {};
  235. my $url = $self->_make_server($topic).$path;
  236. return $self->_query(0, PUT => $url => { "Content-Type"=>"application/json" } => j($params));
  237. }
  238. sub put_json_p
  239. {
  240. my $self = shift;
  241. my $topic = shift;
  242. my $path = shift;
  243. my $params = shift || {};
  244. my $url = $self->_make_server($topic).$path;
  245. return $self->_query(1, PUT => $url => { "Content-Type"=>"application/json" } => j($params));
  246. }
  247. sub patch
  248. {
  249. my $self = shift;
  250. my $topic = shift;
  251. my $path = shift;
  252. my $params = shift || {};
  253. my $url = $self->_make_server($topic).$path;
  254. return $self->_query(0, PATCH => $url => form => $params);
  255. }
  256. sub patch_json
  257. {
  258. my $self = shift;
  259. my $topic = shift;
  260. my $path = shift;
  261. my $params = shift || {};
  262. my $url = $self->_make_server($topic).$path;
  263. return $self->_query(0, PATCH => $url => { "Content-Type"=>"application/json" } => j($params));
  264. }
  265. sub patch_p
  266. {
  267. my $self = shift;
  268. my $topic = shift;
  269. my $path = shift;
  270. my $params = shift || {};
  271. my $url = $self->_make_server($topic).$path;
  272. return $self->_query(1, PATCH => $url => form => $params);
  273. }
  274. sub patch_json_p
  275. {
  276. my $self = shift;
  277. my $topic = shift;
  278. my $path = shift;
  279. my $params = shift || {};
  280. my $url = $self->_make_server($topic).$path;
  281. return $self->_query(1, PATCH => $url => { "Content-Type"=>"application/json" } => j($params));
  282. }
  283. sub map
  284. {
  285. my $self = shift;
  286. my $map = shift;
  287. $self->{map} = $map;
  288. }
  289. sub _make_server
  290. {
  291. my $self = shift;
  292. my $topic = shift;
  293. return $self->{map}->{$topic} if $self->{map} && exists $self->{map}->{$topic};
  294. my $server = $self->{tpl};
  295. $server =~ s/\{entity\}/$topic/;
  296. $server =~ s/darsan-darsan/darsan/;
  297. return $server;
  298. }
  299. sub clone
  300. {
  301. my $self = shift;
  302. return bless { %$self }, "darsan_client";
  303. }
  304. sub auth
  305. {
  306. my $self = shift;
  307. my $auth = shift;
  308. $self->{auth} = $auth;
  309. return $self;
  310. }
  311. 1;