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