| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # ABSTRACT: Internal module with the API specification | 
| 2 |  |  |  |  |  |  | package Arango::Tango::API; | 
| 3 |  |  |  |  |  |  | $Arango::Tango::API::VERSION = '0.019'; | 
| 4 |  |  |  |  |  |  | #use Arango::Tango::Database; | 
| 5 |  |  |  |  |  |  | #use Arango::Tango::Collection; | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 5 |  |  | 5 |  | 38 | use strict; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 140 |  | 
| 8 | 5 |  |  | 5 |  | 26 | use warnings; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 115 |  | 
| 9 | 5 |  |  | 5 |  | 3459 | use HTTP::Tiny; | 
|  | 5 |  |  |  |  | 254386 |  | 
|  | 5 |  |  |  |  | 193 |  | 
| 10 | 5 |  |  | 5 |  | 3212 | use JSON; | 
|  | 5 |  |  |  |  | 60267 |  | 
|  | 5 |  |  |  |  | 28 |  | 
| 11 | 5 |  |  | 5 |  | 2669 | use Clone 'clone'; | 
|  | 5 |  |  |  |  | 10222 |  | 
|  | 5 |  |  |  |  | 331 |  | 
| 12 | 5 |  |  | 5 |  | 2098 | use MIME::Base64 3.11 'encode_base64url'; | 
|  | 5 |  |  |  |  | 3152 |  | 
|  | 5 |  |  |  |  | 308 |  | 
| 13 | 5 |  |  | 5 |  | 2245 | use URI::Encode qw(uri_encode); | 
|  | 5 |  |  |  |  | 56411 |  | 
|  | 5 |  |  |  |  | 326 |  | 
| 14 | 5 |  |  | 5 |  | 2607 | use JSON::Schema::Fit 0.07; | 
|  | 5 |  |  |  |  | 40564 |  | 
|  | 5 |  |  |  |  | 188 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 | 5 |  |  | 5 |  | 2246 | use Sub::Install qw(install_sub); | 
|  | 5 |  |  |  |  | 8703 |  | 
|  | 5 |  |  |  |  | 23 |  | 
| 17 | 5 |  |  | 5 |  | 2662 | use Sub::Name    qw(subname); | 
|  | 5 |  |  |  |  | 2483 |  | 
|  | 5 |  |  |  |  | 7695 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | sub _install_methods($$) { | 
| 22 | 15 |  |  | 15 |  | 58 | my ($package, $methods) = @_; | 
| 23 | 15 |  |  |  |  | 188 | for my $method (keys %$methods) { | 
| 24 | 225 |  |  |  |  | 9825 | my $value = $methods->{$method}; | 
| 25 |  |  |  |  |  |  | install_sub { | 
| 26 |  |  |  |  |  |  | into => $package, | 
| 27 |  |  |  |  |  |  | as => $method, | 
| 28 |  |  |  |  |  |  | code => subname( | 
| 29 |  |  |  |  |  |  | "${package}::$method", | 
| 30 |  |  |  |  |  |  | sub { | 
| 31 | 0 |  |  | 0 |  |  | my $self = shift; | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
|  |  |  |  | 0 |  |  |  | 
| 32 | 0 |  |  |  |  |  | my %required = (); | 
| 33 | 0 |  |  |  |  |  | my %optional = (); | 
| 34 | 0 | 0 |  |  |  |  | if (exists($value->{signature})) { | 
| 35 | 0 | 0 |  |  |  |  | if (scalar(@_) < scalar( grep { !/^\?/ } @{$value->{signature}})) { | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 36 | 0 |  |  |  |  |  | die sprintf("Arango::Tango | %s | Missing %s", $method, $value->{signature}[scalar(@_) - 1]); | 
| 37 |  |  |  |  |  |  | } | 
| 38 | 0 |  |  |  |  |  | %required = ( map { $_ => shift @_ } grep { !/^\?/ } @{$value->{signature}} ); | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | %optional = ( map { | 
| 40 | 0 | 0 |  |  |  |  | /^\?(.+)$/ and $a = $1; | 
| 41 | 0 | 0 |  |  |  |  | ref($_[0]) ? () : ($a => shift @_) | 
| 42 | 0 |  |  |  |  |  | } grep {  /^\?/ } @{$value->{signature}} ); | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 0 |  |  |  |  |  | %required = ( %required, %optional ); | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 0 | 0 |  |  |  |  | if (exists($value->{inject_properties})) { | 
| 48 | 0 |  |  |  |  |  | foreach my $property (@{$value->{inject_properties}}) { | 
|  | 0 |  |  |  |  |  |  | 
| 49 | 0 | 0 |  |  |  |  | if (ref($property) eq "HASH") { | 
| 50 | 0 | 0 |  |  |  |  | die "Property injection without property" unless exists $property->{prop}; | 
| 51 | 0 | 0 |  |  |  |  | die "Property injection without alias"    unless exists $property->{as}; | 
| 52 | 0 |  |  |  |  |  | $required{$property->{as}} = $self->{$property->{prop}}; | 
| 53 |  |  |  |  |  |  | } | 
| 54 |  |  |  |  |  |  | else { | 
| 55 | 0 |  |  |  |  |  | $required{$property} = $self->{$property}; | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  | } | 
| 59 | 0 | 0 |  |  |  |  | die sprintf("Arango::Tango | %s | Odd number of elements on options hash", $method) if scalar(@_) % 2; | 
| 60 | 0 | 0 |  |  |  |  | my $arango = ref($self) eq "Arango::Tango" ? $self : $self->{arango}; | 
| 61 | 0 |  |  |  |  |  | return $arango->__api( $value, { @_, %required }); | 
| 62 |  |  |  |  |  |  | }) | 
| 63 | 225 |  |  |  |  | 2470 | }; | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | my %API = ( | 
| 68 |  |  |  |  |  |  | 'bulk_import_list'   => { | 
| 69 |  |  |  |  |  |  | rest => [ post => '{{database}}_api/import?collection={collection}'], | 
| 70 |  |  |  |  |  |  | url_schema => { | 
| 71 |  |  |  |  |  |  | type        => { type => 'string', pattern => 'documents|list|auto'  }, | 
| 72 |  |  |  |  |  |  | fromPrefix  => { type => 'string'  }, | 
| 73 |  |  |  |  |  |  | toPrefix    => { type => 'string'  }, | 
| 74 |  |  |  |  |  |  | overwrite   => { type => 'boolean' }, | 
| 75 |  |  |  |  |  |  | waitForSync => { type => 'boolean' }, | 
| 76 |  |  |  |  |  |  | onDuplicate => { type => 'string', pattern => 'error|update|replace|ignore'  }, | 
| 77 |  |  |  |  |  |  | complete    => { type => 'boolean' }, | 
| 78 |  |  |  |  |  |  | details     => { type => 'boolean' } | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  | }, | 
| 81 |  |  |  |  |  |  | 'create_document'    => { | 
| 82 |  |  |  |  |  |  | rest => [ post  => '{{database}}_api/document/{collection}'] | 
| 83 |  |  |  |  |  |  | }, | 
| 84 |  |  |  |  |  |  | 'replace_document'   => { | 
| 85 |  |  |  |  |  |  | rest => [ put => '{{database}}_api/document/{collection}/{key}' ], | 
| 86 |  |  |  |  |  |  | }, | 
| 87 |  |  |  |  |  |  | 'list_collections'   => { | 
| 88 |  |  |  |  |  |  | rest => [ get   => '{{database}}_api/collection'], | 
| 89 |  |  |  |  |  |  | schema => { excludeSystem => { type => 'boolean' } } | 
| 90 |  |  |  |  |  |  | }, | 
| 91 |  |  |  |  |  |  | 'cursor_next'        => { | 
| 92 |  |  |  |  |  |  | rest => [ put => '{{database}}_api/cursor/{id}'] | 
| 93 |  |  |  |  |  |  | }, | 
| 94 |  |  |  |  |  |  | 'cursor_delete'      => { | 
| 95 |  |  |  |  |  |  | rest => [ delete => '{{database}}_api/cursor/{id}'] | 
| 96 |  |  |  |  |  |  | }, | 
| 97 |  |  |  |  |  |  | 'accessible_databases' => { | 
| 98 |  |  |  |  |  |  | rest => [ get => '_api/database/user'] | 
| 99 |  |  |  |  |  |  | }, | 
| 100 |  |  |  |  |  |  | 'all_keys' => { | 
| 101 |  |  |  |  |  |  | rest => [ put => '{{database}}_api/simple/all-keys' ], | 
| 102 |  |  |  |  |  |  | schema => { type => { type => 'string' }, collection => { type => 'string' } }, | 
| 103 |  |  |  |  |  |  | }, | 
| 104 |  |  |  |  |  |  | 'create_cursor' => { | 
| 105 |  |  |  |  |  |  | rest => [ post => '{{database}}_api/cursor' ], | 
| 106 |  |  |  |  |  |  | schema => { | 
| 107 |  |  |  |  |  |  | query       => { type => 'string'  }, | 
| 108 |  |  |  |  |  |  | count       => { type => 'boolean' }, | 
| 109 |  |  |  |  |  |  | batchSize   => { type => 'integer' }, | 
| 110 |  |  |  |  |  |  | cache       => { type => 'boolean' }, | 
| 111 |  |  |  |  |  |  | memoryLimit => { type => 'integer' }, | 
| 112 |  |  |  |  |  |  | ttl         => { type => 'integer' }, | 
| 113 |  |  |  |  |  |  | bindVars => { type => 'object', additionalProperties => 1 }, | 
| 114 |  |  |  |  |  |  | options  => { type => 'object', additionalProperties => 0, properties => { | 
| 115 |  |  |  |  |  |  | failOnWarning               => { type => 'boolean' }, | 
| 116 |  |  |  |  |  |  | profile                     => { type => 'integer', maximum => 2, minimum => 0 }, # 0, 1, 2 | 
| 117 |  |  |  |  |  |  | maxTransactionSize          => { type => 'integer' }, | 
| 118 |  |  |  |  |  |  | stream                      => { type => 'boolean' }, | 
| 119 |  |  |  |  |  |  | skipInaccessibleCollections => { type => 'boolean' }, | 
| 120 |  |  |  |  |  |  | maxWarningCount             => { type => 'integer' }, | 
| 121 |  |  |  |  |  |  | intermediateCommitCount     => { type => 'integer' }, | 
| 122 |  |  |  |  |  |  | satelliteSyncWait           => { type => 'integer' }, | 
| 123 |  |  |  |  |  |  | fullCount                   => { type => 'boolean' }, | 
| 124 |  |  |  |  |  |  | intermediateCommitSize      => { type => 'integer' }, | 
| 125 |  |  |  |  |  |  | 'optimizer.rules'           => { type => 'string'  }, | 
| 126 |  |  |  |  |  |  | maxPlans                    => { type => 'integer' }, | 
| 127 |  |  |  |  |  |  | } | 
| 128 |  |  |  |  |  |  | }, | 
| 129 |  |  |  |  |  |  | }, | 
| 130 |  |  |  |  |  |  | }, | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | create_user => { | 
| 133 |  |  |  |  |  |  | method => 'post', | 
| 134 |  |  |  |  |  |  | uri => '_api/user', | 
| 135 |  |  |  |  |  |  | schema => { | 
| 136 |  |  |  |  |  |  | password => { type => 'string'  }, | 
| 137 |  |  |  |  |  |  | active   => { type => 'boolean' }, | 
| 138 |  |  |  |  |  |  | user     => { type => 'string'  }, | 
| 139 |  |  |  |  |  |  | extra    => { type => 'object', additionalProperties => 1 }, | 
| 140 |  |  |  |  |  |  | } | 
| 141 |  |  |  |  |  |  | }, | 
| 142 |  |  |  |  |  |  | ); | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | sub _check_options { | 
| 147 | 0 |  |  | 0 |  |  | my ($params, $properties) = @_; | 
| 148 | 0 |  |  |  |  |  | my $schema = { type => 'object', additionalProperties => 0, properties => $properties }; | 
| 149 | 0 |  |  |  |  |  | my $prepared_data = JSON::Schema::Fit->new(replace_invalid_values => 1)->get_adjusted($params, $schema); | 
| 150 | 0 |  |  |  |  |  | return $prepared_data; | 
| 151 |  |  |  |  |  |  | } | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | sub _api { | 
| 154 | 0 |  |  | 0 |  |  | my ($self, $action, $params) = @_; | 
| 155 | 0 |  |  |  |  |  | return $self->__api( $API{$action}, $params); | 
| 156 |  |  |  |  |  |  | } | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | sub __api { | 
| 159 | 0 |  |  | 0 |  |  | my ($self, $conf, $params) = @_; | 
| 160 |  |  |  |  |  |  |  | 
| 161 | 0 |  |  |  |  |  | my ($method, $uri) = @{$conf->{rest}}; | 
|  | 0 |  |  |  |  |  |  | 
| 162 | 0 |  |  |  |  |  | $method = uc $method; | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 0 |  |  |  |  |  | my $params_copy = clone $params; ## FIXME: decide if this is relevant | 
| 165 |  |  |  |  |  |  |  | 
| 166 | 0 | 0 |  |  |  |  | $uri =~ s[\{\{database\}\}]  [ defined $params->{database} ? "_db/$params->{database}/" : "" ]e; | 
|  | 0 |  |  |  |  |  |  | 
| 167 | 0 |  | 0 |  |  |  | $uri =~ s[\{([^}]+)\}]  [$params->{$1} // ""]eg; | 
|  | 0 |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  |  | 
| 169 | 0 |  |  |  |  |  | my $url = sprintf("%s://%s:%d/%s", $self->{scheme}, $self->{host}, $self->{port}, $uri); | 
| 170 |  |  |  |  |  |  |  | 
| 171 | 0 |  |  |  |  |  | my $body = undef; | 
| 172 | 0 |  |  |  |  |  | my $opts = {}; | 
| 173 | 0 |  |  |  |  |  | my $url_opts = {}; | 
| 174 | 0 | 0 |  |  |  |  | if (ref($params) eq "HASH") { | 
| 175 | 0 | 0 |  |  |  |  | $body = $params->{_body} if exists $params->{_body}; | 
| 176 | 0 | 0 | 0 |  |  |  | $url_opts = $params->{_url_parameters} if exists $params->{_url_parameters} and ref($params->{_url_parameters}) eq "HASH"; | 
| 177 | 0 |  |  |  |  |  | $opts = $params; | 
| 178 | 0 |  |  |  |  |  | for (qw._body _parameters.) { | 
| 179 | 0 | 0 |  |  |  |  | delete $opts->{$_} if exists $opts->{$_}; | 
| 180 |  |  |  |  |  |  | } | 
| 181 |  |  |  |  |  |  | } | 
| 182 | 0 | 0 |  |  |  |  | $opts = exists($conf->{schema}) ? _check_options($opts, $conf->{schema}) : {}; | 
| 183 | 0 | 0 |  |  |  |  | $url_opts = exists($conf->{url_schema}) ? _check_options($url_opts, $conf->{url_schema}) : {}; | 
| 184 |  |  |  |  |  |  |  | 
| 185 | 0 | 0 |  |  |  |  | if (keys %$url_opts) { | 
| 186 |  |  |  |  |  |  | my $url_parameters = join("&", map { | 
| 187 | 0 |  |  |  |  |  | my $val = $url_opts->{$_}; | 
|  | 0 |  |  |  |  |  |  | 
| 188 | 0 | 0 |  |  |  |  | if (ref($val) eq "JSON::PP::Boolean") { | 
| 189 | 0 | 0 |  |  |  |  | $val = $val ? "yes" : "no" | 
| 190 |  |  |  |  |  |  | } | 
| 191 | 0 |  |  |  |  |  | "$_=$val" } keys %$url_opts); | 
| 192 | 0 | 0 |  |  |  |  | $url .= ($url =~ /\?/ ? "&" : "?") . $url_parameters; | 
| 193 |  |  |  |  |  |  | } | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  |  | 
| 196 | 0 | 0 | 0 |  |  |  | if (exists($conf->{require_document}) && !$body) { | 
| 197 | 0 |  |  |  |  |  | die "Arango::Tango | Document missing\n    [ $method => $url ]\n"; | 
| 198 |  |  |  |  |  |  | } | 
| 199 |  |  |  |  |  |  |  | 
| 200 | 0 | 0 | 0 |  |  |  | if ($method eq 'GET' && scalar(keys %$opts)) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
| 201 | 0 |  |  |  |  |  | $url .= "?" . join("&", map { "$_=" . uri_encode($opts->{$_} )} keys %$opts); | 
|  | 0 |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  | elsif ($body && (ref($body) eq "HASH" || ref($body) eq "ARRAY")) { | 
| 204 | 0 |  |  |  |  |  | $opts = { content => encode_json $body } | 
| 205 |  |  |  |  |  |  | } | 
| 206 |  |  |  |  |  |  | elsif (defined($body)) { # JSON | 
| 207 | 0 |  |  |  |  |  | $opts = { content => $body } | 
| 208 |  |  |  |  |  |  | } | 
| 209 |  |  |  |  |  |  | else { | 
| 210 | 0 |  |  |  |  |  | $opts = { content => encode_json $opts } | 
| 211 |  |  |  |  |  |  | } | 
| 212 |  |  |  |  |  |  |  | 
| 213 | 0 |  |  |  |  |  | my $response = $self->{http}->request($method, $url, $opts); | 
| 214 | 0 |  |  |  |  |  | $self->{last_error} = $response->{status}; | 
| 215 |  |  |  |  |  |  |  | 
| 216 | 0 | 0 |  |  |  |  | if ($response->{success}) { | 
| 217 | 0 |  |  |  |  |  | my $ans = decode_json($response->{content}); | 
| 218 | 0 | 0 |  |  |  |  | if ($ans->{error}) { | 
|  |  | 0 |  |  |  |  |  | 
| 219 | 0 |  |  |  |  |  | return $ans; | 
| 220 |  |  |  |  |  |  | } elsif (exists($conf->{builder})) { | 
| 221 | 0 |  |  |  |  |  | return $conf->{builder}->( $self, %$params_copy ); | 
| 222 |  |  |  |  |  |  | } else { | 
| 223 | 0 |  |  |  |  |  | return $ans; | 
| 224 |  |  |  |  |  |  | } | 
| 225 |  |  |  |  |  |  | } | 
| 226 |  |  |  |  |  |  | else { | 
| 227 |  |  |  |  |  |  |  | 
| 228 | 0 |  |  |  |  |  | die "Arango::Tango | ($response->{status}) $response->{reason}\n    [ $method => $url ]\n"; | 
| 229 |  |  |  |  |  |  | } | 
| 230 |  |  |  |  |  |  | } | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | 1; | 
| 235 |  |  |  |  |  |  |  | 
| 236 |  |  |  |  |  |  | __END__ |