line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package ArangoDB2::Base; |
2
|
|
|
|
|
|
|
|
3
|
20
|
|
|
20
|
|
104
|
use strict; |
|
20
|
|
|
|
|
26
|
|
|
20
|
|
|
|
|
666
|
|
4
|
20
|
|
|
20
|
|
74
|
use warnings; |
|
20
|
|
|
|
|
27
|
|
|
20
|
|
|
|
|
488
|
|
5
|
|
|
|
|
|
|
|
6
|
20
|
|
|
20
|
|
80
|
use Carp qw(croak); |
|
20
|
|
|
|
|
20
|
|
|
20
|
|
|
|
|
1288
|
|
7
|
20
|
|
|
20
|
|
1775
|
use Data::Dumper; |
|
20
|
|
|
|
|
8100
|
|
|
20
|
|
|
|
|
911
|
|
8
|
20
|
|
|
20
|
|
13576
|
use JSON::XS; |
|
20
|
|
|
|
|
89823
|
|
|
20
|
|
|
|
|
1537
|
|
9
|
20
|
|
|
20
|
|
121
|
use Scalar::Util qw(blessed weaken); |
|
20
|
|
|
|
|
27
|
|
|
20
|
|
|
|
|
17193
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# new |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# Arango organizes data hierarchically: Databases > Collections > Documents |
16
|
|
|
|
|
|
|
# |
17
|
|
|
|
|
|
|
# This constructor can build ArangoDB2::Database, Collection, Document, Edge, |
18
|
|
|
|
|
|
|
# etc. objects which all follow the same pattern |
19
|
|
|
|
|
|
|
sub new |
20
|
|
|
|
|
|
|
{ |
21
|
52
|
|
|
52
|
1
|
83
|
my $class = shift; |
22
|
|
|
|
|
|
|
# new instance |
23
|
52
|
|
|
|
|
75
|
my $self = {}; |
24
|
52
|
|
|
|
|
91
|
bless($self, $class); |
25
|
|
|
|
|
|
|
# process args |
26
|
52
|
|
|
|
|
148
|
while (my $arg = shift) { |
27
|
|
|
|
|
|
|
# if arg is a ref it should be another |
28
|
|
|
|
|
|
|
# ArangoDB::* object |
29
|
123
|
100
|
|
|
|
201
|
if (ref $arg) { |
30
|
|
|
|
|
|
|
# prevent circular ref |
31
|
98
|
|
|
|
|
195
|
weaken $arg; |
32
|
|
|
|
|
|
|
# create reference to parent object |
33
|
98
|
|
|
|
|
410
|
$self->{$arg->_class} = $arg; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
# if arg is a string then it is the "name" |
36
|
|
|
|
|
|
|
# of this object |
37
|
|
|
|
|
|
|
else { |
38
|
25
|
|
|
|
|
143
|
$self->name($arg); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
# if we have a name and can get then try it |
42
|
52
|
50
|
66
|
|
|
144
|
$self->get if defined $self->name |
43
|
|
|
|
|
|
|
and $self->can('get'); |
44
|
|
|
|
|
|
|
|
45
|
52
|
|
|
|
|
168
|
return $self; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# api_path |
49
|
|
|
|
|
|
|
# |
50
|
|
|
|
|
|
|
# return /_db//_api |
51
|
|
|
|
|
|
|
sub api_path |
52
|
|
|
|
|
|
|
{ |
53
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
54
|
|
|
|
|
|
|
|
55
|
0
|
0
|
|
|
|
0
|
my $db_name |
56
|
|
|
|
|
|
|
= $self->database |
57
|
|
|
|
|
|
|
? $self->database->name |
58
|
|
|
|
|
|
|
: $self->name; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
0
|
return '/' . join('/', '_db', $db_name, '_api', @_); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# arango |
64
|
|
|
|
|
|
|
# |
65
|
|
|
|
|
|
|
# ArangoDB2 instance |
66
|
31
|
|
|
31
|
1
|
217
|
sub arango { $_[0]->{arango} } |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# collection |
69
|
|
|
|
|
|
|
# |
70
|
|
|
|
|
|
|
# parent ArangoDB2::Collection instance |
71
|
|
|
|
|
|
|
sub collection { |
72
|
0
|
|
|
0
|
1
|
0
|
my($self, $value) = @_; |
73
|
|
|
|
|
|
|
|
74
|
0
|
0
|
|
|
|
0
|
if (defined $value) { |
75
|
|
|
|
|
|
|
# if value is already an object then set it |
76
|
0
|
0
|
|
|
|
0
|
if (ref $value) { |
77
|
0
|
|
|
|
|
0
|
$self->{collection} = $value; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
# otherwise treat as name and get collection object |
80
|
|
|
|
|
|
|
else { |
81
|
0
|
|
|
|
|
0
|
$self->{collection} = $self->database->collection($value); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
0
|
return $self->{collection}; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# data |
89
|
|
|
|
|
|
|
# |
90
|
|
|
|
|
|
|
# ref to hash containing document data |
91
|
0
|
|
|
0
|
1
|
0
|
sub data { shift->_get_set('data', @_) } |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# database |
94
|
|
|
|
|
|
|
# |
95
|
|
|
|
|
|
|
# parent ArangoDB2::Database instance |
96
|
12
|
|
|
12
|
1
|
88
|
sub database { $_[0]->{database} } |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# graph |
99
|
|
|
|
|
|
|
# |
100
|
|
|
|
|
|
|
# parent ArangoDB2::Graph instance |
101
|
2
|
|
|
2
|
1
|
19
|
sub graph { $_[0]->{graph} } |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# id |
104
|
|
|
|
|
|
|
# |
105
|
|
|
|
|
|
|
# ArangoDB _id |
106
|
0
|
|
|
0
|
1
|
0
|
sub id { $_[0]->{id} } |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# name |
109
|
|
|
|
|
|
|
# |
110
|
|
|
|
|
|
|
# name/handle of object |
111
|
77
|
|
|
77
|
1
|
263
|
sub name { shift->_get_set_name('name', @_) } |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# rev |
114
|
|
|
|
|
|
|
# |
115
|
|
|
|
|
|
|
# ArangoDB _rev |
116
|
0
|
|
|
0
|
1
|
0
|
sub rev { $_[0]->{rev} } |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# _build_args |
119
|
|
|
|
|
|
|
# |
120
|
|
|
|
|
|
|
# process args for requests |
121
|
|
|
|
|
|
|
sub _build_args |
122
|
|
|
|
|
|
|
{ |
123
|
0
|
|
|
0
|
|
0
|
my($self, $args, $params) = @_; |
124
|
|
|
|
|
|
|
# require hash ref for args |
125
|
0
|
0
|
0
|
|
|
0
|
$args = {} unless defined $args |
|
|
|
0
|
|
|
|
|
126
|
|
|
|
|
|
|
and ref $args and ref $args eq 'HASH'; |
127
|
|
|
|
|
|
|
# if an explicit list is not passed for this call |
128
|
|
|
|
|
|
|
# then use global list for class |
129
|
0
|
|
0
|
|
|
0
|
$params ||= $self->_params; |
130
|
|
|
|
|
|
|
# for each of the allowed parameters use the |
131
|
|
|
|
|
|
|
# setter to set the value if it is passed and |
132
|
|
|
|
|
|
|
# and the value to the request args if it is |
133
|
|
|
|
|
|
|
# defined |
134
|
0
|
|
|
|
|
0
|
for my $param (@$params) { |
135
|
|
|
|
|
|
|
# if params is pased in args then it supersedes |
136
|
|
|
|
|
|
|
# any value set as a property of the object |
137
|
0
|
0
|
|
|
|
0
|
if (exists $args->{$param}) { |
|
|
0
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# run arg through setter with validate only |
139
|
|
|
|
|
|
|
# flag which will return the validated arg |
140
|
0
|
|
|
|
|
0
|
$args->{$param} = $self->$param($args->{$param}, 1); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
# otherwise if the param is set then add to args |
143
|
|
|
|
|
|
|
elsif (defined $self->$param) { |
144
|
0
|
|
|
|
|
0
|
$args->{$param} = $self->$param; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
0
|
return $args; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# _build_self |
152
|
|
|
|
|
|
|
# |
153
|
|
|
|
|
|
|
# copy param values from passed data to self |
154
|
|
|
|
|
|
|
sub _build_self |
155
|
|
|
|
|
|
|
{ |
156
|
0
|
|
|
0
|
|
0
|
my($self, $data, $params) = @_; |
157
|
|
|
|
|
|
|
# require data |
158
|
0
|
0
|
|
|
|
0
|
croak "Invalid Args" |
159
|
|
|
|
|
|
|
unless ref $data eq 'HASH'; |
160
|
|
|
|
|
|
|
# if an explicit list is not passed for this call |
161
|
|
|
|
|
|
|
# then use global list for class |
162
|
0
|
|
0
|
|
|
0
|
$params ||= $self->_params; |
163
|
|
|
|
|
|
|
# copy params |
164
|
0
|
|
|
|
|
0
|
for my $param (@$params) { |
165
|
0
|
0
|
|
|
|
0
|
$self->{$param} = delete $data->{$param} |
166
|
|
|
|
|
|
|
if exists $data->{$param}; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
# copy _id and _rev to id/rev |
169
|
0
|
0
|
|
|
|
0
|
$self->{id} = delete $data->{_id} |
170
|
|
|
|
|
|
|
if exists $data->{_id}; |
171
|
0
|
0
|
|
|
|
0
|
$self->{rev} = delete $data->{_rev} |
172
|
|
|
|
|
|
|
if exists $data->{_rev}; |
173
|
|
|
|
|
|
|
# if user is set then use it as name |
174
|
0
|
0
|
|
|
|
0
|
if (exists $data->{user}) { |
|
|
0
|
|
|
|
|
|
175
|
0
|
|
|
|
|
0
|
$self->{name} = delete $data->{user}; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
# otherwise try _key |
178
|
|
|
|
|
|
|
elsif (exists $data->{_key}) { |
179
|
0
|
|
|
|
|
0
|
$self->{name} = delete $data->{_key} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
# copy to and from |
182
|
0
|
0
|
|
|
|
0
|
$self->{from} = delete $data->{_from} |
183
|
|
|
|
|
|
|
if exists $data->{_from}; |
184
|
0
|
0
|
|
|
|
0
|
$self->{to} = delete $data->{_to} |
185
|
|
|
|
|
|
|
if exists $data->{_to}; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
0
|
return $self; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# _get_set |
191
|
|
|
|
|
|
|
# |
192
|
|
|
|
|
|
|
# either get or set value. |
193
|
|
|
|
|
|
|
# setting value returns self. |
194
|
|
|
|
|
|
|
sub _get_set |
195
|
|
|
|
|
|
|
{ |
196
|
2
|
|
|
2
|
|
4
|
my($self, $param, $value, $validate) = @_; |
197
|
|
|
|
|
|
|
|
198
|
2
|
50
|
|
|
|
5
|
if (defined $value) { |
199
|
|
|
|
|
|
|
# if we are only validating then return valid value |
200
|
0
|
0
|
|
|
|
0
|
return $value if $validate; |
201
|
|
|
|
|
|
|
# set value and return self |
202
|
0
|
|
|
|
|
0
|
$self->{$param} = $value; |
203
|
0
|
|
|
|
|
0
|
return $self; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
else { |
206
|
|
|
|
|
|
|
# return currently set value |
207
|
2
|
|
|
|
|
5
|
return $self->{$param}; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# _get_set_bool |
212
|
|
|
|
|
|
|
# |
213
|
|
|
|
|
|
|
# either get value or set JSON bool value. |
214
|
|
|
|
|
|
|
# setting value returns self. |
215
|
|
|
|
|
|
|
sub _get_set_bool |
216
|
|
|
|
|
|
|
{ |
217
|
0
|
|
|
0
|
|
0
|
my($self, $param, $value, $validate) = @_; |
218
|
|
|
|
|
|
|
|
219
|
0
|
0
|
|
|
|
0
|
if (defined $value) { |
220
|
|
|
|
|
|
|
# accept "true" as JSON bool false |
221
|
0
|
0
|
|
|
|
0
|
if ($value eq "true") { |
|
|
0
|
|
|
|
|
|
222
|
0
|
|
|
|
|
0
|
$value = JSON::XS::true; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
# accept "false" as JSON bool false |
225
|
|
|
|
|
|
|
elsif ($value eq "false") { |
226
|
0
|
|
|
|
|
0
|
$value = JSON::XS::false; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
# use the true/false of value to determine JSON bool |
229
|
|
|
|
|
|
|
else { |
230
|
0
|
0
|
|
|
|
0
|
$value = $value ? JSON::XS::true : JSON::XS::false; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
# if we are only validating then return valid value |
233
|
0
|
0
|
|
|
|
0
|
return $value if $validate; |
234
|
|
|
|
|
|
|
# set value and return self |
235
|
0
|
|
|
|
|
0
|
$self->{$param} = $value; |
236
|
0
|
|
|
|
|
0
|
return $self; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
else { |
239
|
|
|
|
|
|
|
# return currently set value |
240
|
0
|
|
|
|
|
0
|
return $self->{$param}; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# _get_set_id |
245
|
|
|
|
|
|
|
# |
246
|
|
|
|
|
|
|
# get/set id with either string or object |
247
|
|
|
|
|
|
|
# setting a value returns self |
248
|
|
|
|
|
|
|
sub _get_set_id |
249
|
|
|
|
|
|
|
{ |
250
|
0
|
|
|
0
|
|
0
|
my($self, $param, $value, $validate) = @_; |
251
|
|
|
|
|
|
|
|
252
|
0
|
0
|
|
|
|
0
|
if (defined $value) { |
253
|
|
|
|
|
|
|
# get value from an ArangoDB2 object |
254
|
0
|
0
|
0
|
|
|
0
|
if ( blessed $value && $value->can('id') ) { |
255
|
0
|
|
|
|
|
0
|
$value = $value->id |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
# if we are only validating then return valid value |
258
|
0
|
0
|
|
|
|
0
|
return $value if $validate; |
259
|
|
|
|
|
|
|
# set value and return self |
260
|
0
|
|
|
|
|
0
|
$self->{$param} = $value; |
261
|
0
|
|
|
|
|
0
|
return $self; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
else { |
264
|
|
|
|
|
|
|
# return currently set value |
265
|
0
|
|
|
|
|
0
|
return $self->{$param}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# _get_set_name |
270
|
|
|
|
|
|
|
# |
271
|
|
|
|
|
|
|
# get/set name with either name or object |
272
|
|
|
|
|
|
|
# setting a value returns self |
273
|
|
|
|
|
|
|
sub _get_set_name |
274
|
|
|
|
|
|
|
{ |
275
|
77
|
|
|
77
|
|
99
|
my($self, $param, $value, $validate) = @_; |
276
|
|
|
|
|
|
|
|
277
|
77
|
100
|
|
|
|
137
|
if (defined $value) { |
278
|
|
|
|
|
|
|
# get value from an ArangoDB2 object |
279
|
25
|
50
|
33
|
|
|
1533
|
if ( blessed $value && $value->can('name') ) { |
280
|
0
|
|
|
|
|
0
|
$value = $value->name |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
# if we are only validating then return valid value |
283
|
25
|
50
|
|
|
|
69
|
return $value if $validate; |
284
|
|
|
|
|
|
|
# set value and return self |
285
|
25
|
|
|
|
|
51
|
$self->{$param} = $value; |
286
|
25
|
|
|
|
|
92
|
return $self; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
else { |
289
|
|
|
|
|
|
|
# return currently set value |
290
|
52
|
|
|
|
|
396
|
return $self->{$param}; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
1; |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
__END__ |