File Coverage

blib/lib/ArangoDB2/Base.pm
Criterion Covered Total %
statement 42 97 43.3
branch 8 58 13.7
condition 3 21 14.2
subroutine 13 22 59.0
pod 10 10 100.0
total 76 208 36.5


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__