| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::Azure::CognitiveServices::Face::Base; | 
| 2 | 29 |  |  | 29 |  | 234 | use strict; | 
|  | 29 |  |  |  |  | 61 |  | 
|  | 29 |  |  |  |  | 795 |  | 
| 3 | 29 |  |  | 29 |  | 142 | use warnings; | 
|  | 29 |  |  |  |  | 65 |  | 
|  | 29 |  |  |  |  | 647 |  | 
| 4 | 29 |  |  | 29 |  | 20600 | use HTTP::Tiny; | 
|  | 29 |  |  |  |  | 1439796 |  | 
|  | 29 |  |  |  |  | 1134 |  | 
| 5 | 29 |  |  | 29 |  | 17937 | use JSON; | 
|  | 29 |  |  |  |  | 338290 |  | 
|  | 29 |  |  |  |  | 180 |  | 
| 6 | 29 |  |  | 29 |  | 4321 | use Carp; | 
|  | 29 |  |  |  |  | 76 |  | 
|  | 29 |  |  |  |  | 1704 |  | 
| 7 | 29 |  |  | 29 |  | 14812 | use URI; | 
|  | 29 |  |  |  |  | 123951 |  | 
|  | 29 |  |  |  |  | 17340 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | sub new { | 
| 10 | 28 |  |  | 28 | 0 | 155 | my ($class, %opts) = @_; | 
| 11 | 28 |  |  |  |  | 389 | return bless {%opts}, $class; | 
| 12 |  |  |  |  |  |  | } | 
| 13 |  |  |  |  |  |  |  | 
| 14 | 28 |  |  | 28 | 1 | 175 | sub access_key {shift->{access_key}} | 
| 15 | 28 |  |  | 28 | 1 | 235 | sub endpoint {shift->{endpoint}} | 
| 16 |  |  |  |  |  |  |  | 
| 17 | 0 |  |  | 0 | 1 | 0 | sub path {''}; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | sub uri { | 
| 20 | 28 |  |  | 28 | 1 | 98 | my ($self, $path, %query) = @_; | 
| 21 | 28 |  |  |  |  | 148 | my $uri = URI->new($self->endpoint); | 
| 22 | 28 | 100 |  |  |  | 238059 | $uri->path($path ? join('/', $self->path, $path) : $self->path); | 
| 23 | 28 | 100 |  |  |  | 3263 | if (keys %query) { | 
| 24 | 4 |  |  |  |  | 36 | $uri->query_form(%query); | 
| 25 |  |  |  |  |  |  | } | 
| 26 | 28 |  |  |  |  | 608 | $uri; | 
| 27 |  |  |  |  |  |  | } | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | sub json { | 
| 30 | 15 |  |  | 15 | 1 | 45 | my $self = shift; | 
| 31 | 15 |  | 33 |  |  | 454 | $self->{json} ||= JSON->new->utf8(1); | 
| 32 | 15 |  |  |  |  | 252 | $self->{json}; | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | sub agent { | 
| 36 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 37 | 0 |  | 0 |  |  | 0 | $self->{agent} ||= HTTP::Tiny->new(agent => __PACKAGE__, timeout => 60); | 
| 38 | 0 |  |  |  |  | 0 | $self->{agent}; | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | sub request { | 
| 42 | 0 |  |  | 0 | 1 | 0 | my ($self, $req) = @_; | 
| 43 | 0 |  |  |  |  | 0 | my $res; | 
| 44 | 0 |  |  |  |  | 0 | my $try = 0; | 
| 45 | 0 |  |  |  |  | 0 | while (1) { | 
| 46 | 0 |  |  |  |  | 0 | $res = $self->agent->request(@$req); | 
| 47 | 0 |  |  |  |  | 0 | $try++; | 
| 48 | 0 | 0 | 0 |  |  | 0 | if ($try > 10 || $res->{status} != 429) { | 
| 49 | 0 |  |  |  |  | 0 | last; | 
| 50 |  |  |  |  |  |  | } | 
| 51 | 0 |  |  |  |  | 0 | carp sprintf('Retry. Because API said %s', $res->{content}); | 
| 52 |  |  |  |  |  |  | } | 
| 53 | 0 |  |  |  |  | 0 | my $body; | 
| 54 | 0 | 0 |  |  |  | 0 | if ($res->{content}) { | 
| 55 | 0 | 0 |  |  |  | 0 | if ($res->{headers}{'Content-Type'} !~ /application\/json/) { | 
| 56 | 0 |  |  |  |  | 0 | croak($res->{content}); | 
| 57 |  |  |  |  |  |  | } | 
| 58 | 0 |  |  |  |  | 0 | $body = $self->json->decode($res->{content}); | 
| 59 |  |  |  |  |  |  | } | 
| 60 | 0 | 0 |  |  |  | 0 | if (!$res->is_success) { | 
| 61 | 0 |  |  |  |  | 0 | croak($body->{error}{message}); | 
| 62 |  |  |  |  |  |  | } | 
| 63 | 0 |  |  |  |  | 0 | $body; | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub build_headers { | 
| 67 | 28 |  |  | 28 | 1 | 107 | my ($self, @headers) = @_; | 
| 68 |  |  |  |  |  |  | { | 
| 69 | 28 |  |  |  |  | 158 | "Content-Type"              => "application/json", | 
| 70 |  |  |  |  |  |  | "Ocp-Apim-Subscription-Key" => $self->access_key, | 
| 71 |  |  |  |  |  |  | @headers, | 
| 72 |  |  |  |  |  |  | }; | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub build_request { | 
| 76 | 28 |  |  | 28 | 1 | 116 | my ($self, $method, $uri_param, $header, $hash) = @_; | 
| 77 | 28 |  |  |  |  | 192 | my $uri  = $self->uri(@$uri_param); | 
| 78 | 28 | 100 |  |  |  | 222 | my $body = $hash ? $self->json->encode($hash) : undef; | 
| 79 | 28 | 50 |  |  |  | 246 | my $headers = $self->build_headers(defined $header ? @$header : ()); | 
| 80 | 28 |  |  |  |  | 256 | return [$method, $uri, {headers => $headers, content => $body}]; | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | 1; | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | __END__ |