Filename | /usr/local/lib/site_perl/Mentat/Storage/Mongo.pm |
Statements | Executed 202 statements in 3.61ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.31ms | 38.0ms | BEGIN@170 | Mentat::Storage::Mongo::
1 | 1 | 1 | 1.72ms | 1.78ms | BEGIN@155 | Mentat::Storage::Mongo::
1 | 1 | 1 | 1.70ms | 6.96ms | BEGIN@161 | Mentat::Storage::Mongo::
1 | 1 | 1 | 575µs | 718µs | BEGIN@166 | Mentat::Storage::Mongo::
1 | 1 | 1 | 351µs | 518ms | BEGIN@162 | Mentat::Storage::Mongo::
1 | 1 | 1 | 195µs | 493µs | BEGIN@154 | Mentat::Storage::Mongo::
1 | 1 | 1 | 66µs | 10.5s | find_i | Mentat::Storage::Mongo::
3 | 2 | 1 | 63µs | 199µs | _unbless (recurses: max depth 1, inclusive time 175µs) | Mentat::Storage::Mongo::
1 | 1 | 1 | 32µs | 12.8s | find | Mentat::Storage::Mongo::
3 | 3 | 1 | 31µs | 286µs | _encode2json | Mentat::Storage::Mongo::
1 | 1 | 1 | 27µs | 134µs | disconnect | Mentat::Storage::Mongo::
1 | 1 | 1 | 22µs | 8.80ms | reconnect | Mentat::Storage::Mongo::
1 | 1 | 1 | 16µs | 302µs | _set_last_filter | Mentat::Storage::Mongo::
1 | 1 | 1 | 15µs | 15µs | _convertor | Mentat::Storage::Mongo::
1 | 1 | 1 | 14µs | 8.83ms | _init | Mentat::Storage::Mongo::
1 | 1 | 1 | 13µs | 149µs | DESTROY | Mentat::Storage::Mongo::
1 | 1 | 1 | 13µs | 16µs | BEGIN@2 | Mentat::Storage::Mongo::
1 | 1 | 1 | 12µs | 4.73s | _set_last_index | Mentat::Storage::Mongo::
1 | 1 | 1 | 10µs | 38µs | BEGIN@157 | Mentat::Storage::Mongo::
1 | 1 | 1 | 9µs | 50µs | BEGIN@149 | Mentat::Storage::Mongo::
1 | 1 | 1 | 9µs | 12µs | get_last_index | Mentat::Storage::Mongo::
1 | 1 | 1 | 9µs | 9µs | BEGIN@194 | Mentat::Storage::Mongo::
1 | 1 | 1 | 8µs | 33µs | BEGIN@150 | Mentat::Storage::Mongo::
1 | 1 | 1 | 8µs | 84µs | BEGIN@153 | Mentat::Storage::Mongo::
1 | 1 | 1 | 8µs | 19µs | BEGIN@655 | Mentat::Storage::Mongo::
1 | 1 | 1 | 8µs | 40µs | BEGIN@178 | Mentat::Storage::Mongo::
1 | 1 | 1 | 7µs | 14µs | BEGIN@3 | Mentat::Storage::Mongo::
1 | 1 | 1 | 7µs | 34µs | BEGIN@181 | Mentat::Storage::Mongo::
1 | 1 | 1 | 7µs | 45µs | BEGIN@195 | Mentat::Storage::Mongo::
1 | 1 | 1 | 7µs | 7µs | BEGIN@167 | Mentat::Storage::Mongo::
1 | 1 | 1 | 6µs | 32µs | BEGIN@183 | Mentat::Storage::Mongo::
1 | 1 | 1 | 5µs | 5µs | BEGIN@163 | Mentat::Storage::Mongo::
1 | 1 | 1 | 5µs | 5µs | BEGIN@152 | Mentat::Storage::Mongo::
1 | 1 | 1 | 5µs | 5µs | CORE:match (opcode) | Mentat::Storage::Mongo::
1 | 1 | 1 | 4µs | 5µs | get_last_filter | Mentat::Storage::Mongo::
1 | 1 | 1 | 2µs | 2µs | END | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | _create_indexes | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | aggregate | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | change_collection | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | count | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | cursor_iterate | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | delete | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | fetch | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | insert | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | list_collections | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | list_indexes | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | remove | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | run_command | Mentat::Storage::Mongo::
0 | 0 | 0 | 0s | 0s | update | Mentat::Storage::Mongo::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Mentat::Storage::Mongo; | ||||
2 | 2 | 24µs | 2 | 19µs | # spent 16µs (13+3) within Mentat::Storage::Mongo::BEGIN@2 which was called:
# once (13µs+3µs) by main::BEGIN@8 at line 2 # spent 16µs making 1 call to Mentat::Storage::Mongo::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 99µs | 2 | 20µs | # spent 14µs (7+6) within Mentat::Storage::Mongo::BEGIN@3 which was called:
# once (7µs+6µs) by main::BEGIN@8 at line 3 # spent 14µs making 1 call to Mentat::Storage::Mongo::BEGIN@3
# spent 6µs making 1 call to warnings::import |
4 | |||||
5 | #******************************************************************************* | ||||
6 | # DOCUMENTATION SECTION | ||||
7 | #******************************************************************************* | ||||
8 | |||||
9 | =head1 NAME | ||||
10 | |||||
11 | Mentat::Storage::Mongo - Mentat object storage in MongoDB database | ||||
12 | |||||
13 | =head1 SYNOPSIS | ||||
14 | |||||
15 | #*******************************************************************************## | ||||
16 | # !!! MORE USAGE EXAMPLES MAY BE FOUND IN Mentat.Storage.Mongo.t TEST SCRIPT !!! # | ||||
17 | #*******************************************************************************## | ||||
18 | |||||
19 | use Mentat::Storage::Mongo; | ||||
20 | |||||
21 | # Instantinate the database engine | ||||
22 | my $engine = Mentat::Storage::Mongo->new(database => 'db', collection => 'coll'); | ||||
23 | my $engine = Mentat::Storage::Mongo->new(connection => [host => 'host', port => 1234, timeout => 2000], database => 'db', collection => 'coll'); | ||||
24 | |||||
25 | # Any of the following methods may croak, if the database error is encountered, | ||||
26 | # so wrap everything in eval | ||||
27 | eval { | ||||
28 | |||||
29 | # Insert new record into database | ||||
30 | my $record_id = $instance->insert({a => 1, b => 1}); | ||||
31 | |||||
32 | # Fetch the object back from database | ||||
33 | my $object = $engine->fetch($record_id); | ||||
34 | |||||
35 | # Delete the single object from database (based on unique OID) | ||||
36 | my $rv = $engine->delete($record_id); | ||||
37 | |||||
38 | |||||
39 | # Find all objects in database | ||||
40 | my ($objects, $count) = $engine->find(); | ||||
41 | |||||
42 | # Find and filter | ||||
43 | my ($objects, $count) = $engine->find({'_id' => $record_id1}); | ||||
44 | my ($objects, $count) = $engine->find({'a' => {'$gt' => 4}}); | ||||
45 | |||||
46 | # TODO: Projection is broken and doesn`t work for some reason | ||||
47 | |||||
48 | # Find, filter and sort | ||||
49 | my ($objects, $count) = $engine->find({'a' => {'$gt' => 4}}, undef, {'b' => -1}); | ||||
50 | |||||
51 | # Find, filter, sort and limit | ||||
52 | my ($objects, $count) = $engine->find({'a' => {'$gt' => 4}}, undef, {'b' => -1},5); | ||||
53 | |||||
54 | # Find, filter, sort and skip | ||||
55 | my ($objects, $count) = $engine->find({'a' => {'$gt' => 4}}, undef, {'b' => -1}, undef, 10); | ||||
56 | |||||
57 | # Find, filter, sort, limit and skip | ||||
58 | my ($objects, $count) = $engine->find({'a' => {'$gt' => 4}}, undef, {'b' => -1}, 5, 10); | ||||
59 | |||||
60 | |||||
61 | # Using iteration on cursor, arguments are the same as with find() method | ||||
62 | my @result = []; | ||||
63 | my ($cursor, $cnta) = $engine->find_i(); | ||||
64 | # !!!PREFERED METHOD!!! Now either use internal cursor iteration with optional limit | ||||
65 | # This method uses the closures @result is visible in callback method | ||||
66 | sub cb($) { | ||||
67 | push(@result, @_); # OR DO SOME OTHER STUFF HERE | ||||
68 | } | ||||
69 | my $cntb = $engine->cursor_iterate($cursor, \&cb, $limit); | ||||
70 | # !!!DISCOURAGED METHOD!!! Or use cursor directly | ||||
71 | while (my $doc = $cursor->next) { | ||||
72 | push(@result, $doc); # OR DO SOME OTHER STUFF HERE | ||||
73 | } | ||||
74 | # @result now contains all data | ||||
75 | |||||
76 | |||||
77 | # Count number of all records in database | ||||
78 | my $count = $engine->count(); | ||||
79 | |||||
80 | # Count number of records in database, which pass the given filter condition | ||||
81 | my $count = $engine->count({'_id' => $record_id}); | ||||
82 | my $count = $engine->count({'a' => {'$gt' => 4}}); | ||||
83 | |||||
84 | |||||
85 | # Update single or multiple records | ||||
86 | my $rv = $instance->update({'_id' => $record_id1},{a => 'x', b => 'y'}); | ||||
87 | my $rv = $instance->update({a => {'$lte'=>2}},{'$inc' => {b => 3 }}); | ||||
88 | my $rv = $instance->update({a => {'$lte'=>2}},{'$inc' => {b => 3}},{multiple => 1}); | ||||
89 | |||||
90 | |||||
91 | # Remove all Mentat::Messages in database | ||||
92 | my $rv = $engine->remove(); | ||||
93 | |||||
94 | # Remove all Mentat::Messages in database, which pass the given filter condition | ||||
95 | my $rv = $engine->remove({'_id' => $record_id}); | ||||
96 | my $rv = $engine->remove({'a' => {'$gt' => 4}}); | ||||
97 | |||||
98 | |||||
99 | # After find(), count() and remove() methods you may call get_last_filter() | ||||
100 | # method to determine the last filter-sort-limit-skip condition | ||||
101 | my $filter = $engine->get_last_filter(); | ||||
102 | |||||
103 | }; | ||||
104 | if($@) { | ||||
105 | print STDERR "MongoDB error: $@\n"; | ||||
106 | } | ||||
107 | |||||
108 | #*******************************************************************************## | ||||
109 | # !!! MORE USAGE EXAMPLES MAY BE FOUND IN Mentat.Storage.Mongo.t TEST SCRIPT !!! # | ||||
110 | #*******************************************************************************## | ||||
111 | |||||
112 | =head1 DESCRIPTION | ||||
113 | |||||
114 | This engine is used for permanent storage of Mentat objects in document oriented | ||||
115 | MongoDB database. It is the implementation of the base Mentat::Storage | ||||
116 | interface. Implementation is currently based on MongoDB module, which is | ||||
117 | available in CPAN repository. | ||||
118 | |||||
119 | =head1 AUTHOR | ||||
120 | |||||
121 | Jan Mach | ||||
122 | Cesnet, z.s.p.o | ||||
123 | jan.mach@cesnet.cz | ||||
124 | http://www.cesnet.cz | ||||
125 | |||||
126 | =head1 COPYRIGHT | ||||
127 | |||||
128 | This program is free software; you can redistribute | ||||
129 | it and/or modify it under the same terms as Perl itself. | ||||
130 | |||||
131 | The full text of the license can be found in the | ||||
132 | LICENSE file included with this module. | ||||
133 | |||||
134 | =head1 SEE ALSO | ||||
135 | |||||
136 | perl(1), MongoDB(3), Mentat::Storage(3). | ||||
137 | |||||
138 | =head1 FUNCTION REFERENCE | ||||
139 | |||||
140 | =over 4 | ||||
141 | |||||
142 | =cut | ||||
143 | |||||
144 | #******************************************************************************* | ||||
145 | # LIBRARY LOADING SECTION | ||||
146 | #******************************************************************************* | ||||
147 | |||||
148 | #-- Perl core modules ---------------------------------------------------------# | ||||
149 | 2 | 28µs | 2 | 90µs | # spent 50µs (9+40) within Mentat::Storage::Mongo::BEGIN@149 which was called:
# once (9µs+40µs) by main::BEGIN@8 at line 149 # spent 50µs making 1 call to Mentat::Storage::Mongo::BEGIN@149
# spent 40µs making 1 call to Exporter::import |
150 | 2 | 25µs | 2 | 58µs | # spent 33µs (8+25) within Mentat::Storage::Mongo::BEGIN@150 which was called:
# once (8µs+25µs) by main::BEGIN@8 at line 150 # spent 33µs making 1 call to Mentat::Storage::Mongo::BEGIN@150
# spent 25µs making 1 call to Exporter::import |
151 | |||||
152 | 2 | 22µs | 1 | 5µs | # spent 5µs within Mentat::Storage::Mongo::BEGIN@152 which was called:
# once (5µs+0s) by main::BEGIN@8 at line 152 # spent 5µs making 1 call to Mentat::Storage::Mongo::BEGIN@152 |
153 | 2 | 28µs | 2 | 160µs | # spent 84µs (8+76) within Mentat::Storage::Mongo::BEGIN@153 which was called:
# once (8µs+76µs) by main::BEGIN@8 at line 153 # spent 84µs making 1 call to Mentat::Storage::Mongo::BEGIN@153
# spent 76µs making 1 call to Time::HiRes::import |
154 | 2 | 93µs | 2 | 522µs | # spent 493µs (195+298) within Mentat::Storage::Mongo::BEGIN@154 which was called:
# once (195µs+298µs) by main::BEGIN@8 at line 154 # spent 493µs making 1 call to Mentat::Storage::Mongo::BEGIN@154
# spent 28µs making 1 call to Exporter::import |
155 | 2 | 105µs | 1 | 1.78ms | # spent 1.78ms (1.72+56µs) within Mentat::Storage::Mongo::BEGIN@155 which was called:
# once (1.72ms+56µs) by main::BEGIN@8 at line 155 # spent 1.78ms making 1 call to Mentat::Storage::Mongo::BEGIN@155 |
156 | |||||
157 | 2 | 28µs | 2 | 67µs | # spent 38µs (10+29) within Mentat::Storage::Mongo::BEGIN@157 which was called:
# once (10µs+29µs) by main::BEGIN@8 at line 157 # spent 38µs making 1 call to Mentat::Storage::Mongo::BEGIN@157
# spent 29µs making 1 call to Exporter::import |
158 | #use Smart::Comments; #-+-> DEVEL ONLY <-+-# | ||||
159 | |||||
160 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
161 | 2 | 95µs | 2 | 7.07ms | # spent 6.96ms (1.70+5.26) within Mentat::Storage::Mongo::BEGIN@161 which was called:
# once (1.70ms+5.26ms) by main::BEGIN@8 at line 161 # spent 6.96ms making 1 call to Mentat::Storage::Mongo::BEGIN@161
# spent 105µs making 1 call to JSON::import |
162 | 2 | 96µs | 1 | 518ms | # spent 518ms (351µs+518) within Mentat::Storage::Mongo::BEGIN@162 which was called:
# once (351µs+518ms) by main::BEGIN@8 at line 162 # spent 518ms making 1 call to Mentat::Storage::Mongo::BEGIN@162 |
163 | 2 | 23µs | 1 | 5µs | # spent 5µs within Mentat::Storage::Mongo::BEGIN@163 which was called:
# once (5µs+0s) by main::BEGIN@8 at line 163 # spent 5µs making 1 call to Mentat::Storage::Mongo::BEGIN@163 |
164 | |||||
165 | #-- Custom application modules ------------------------------------------------# | ||||
166 | 2 | 100µs | 1 | 718µs | # spent 718µs (575+142) within Mentat::Storage::Mongo::BEGIN@166 which was called:
# once (575µs+142µs) by main::BEGIN@8 at line 166 # spent 718µs making 1 call to Mentat::Storage::Mongo::BEGIN@166 |
167 | 2 | 23µs | 1 | 7µs | # spent 7µs within Mentat::Storage::Mongo::BEGIN@167 which was called:
# once (7µs+0s) by main::BEGIN@8 at line 167 # spent 7µs making 1 call to Mentat::Storage::Mongo::BEGIN@167 |
168 | |||||
169 | # Modules from Cesnet Toolkit | ||||
170 | 2 | 126µs | 1 | 38.0ms | # spent 38.0ms (2.31+35.7) within Mentat::Storage::Mongo::BEGIN@170 which was called:
# once (2.31ms+35.7ms) by main::BEGIN@8 at line 170 # spent 38.0ms making 1 call to Mentat::Storage::Mongo::BEGIN@170 |
171 | |||||
172 | #******************************************************************************* | ||||
173 | # CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION | ||||
174 | #******************************************************************************* | ||||
175 | |||||
176 | #-- Constants -----------------------------------------------------------------# | ||||
177 | |||||
178 | 2 | 28µs | 2 | 72µs | # spent 40µs (8+32) within Mentat::Storage::Mongo::BEGIN@178 which was called:
# once (8µs+32µs) by main::BEGIN@8 at line 178 # spent 40µs making 1 call to Mentat::Storage::Mongo::BEGIN@178
# spent 32µs making 1 call to constant::import |
179 | #use constant DFLT_TIMEOUT => 200000; | ||||
180 | # RO: Nez vyresim problem s mongodb, potrebuji vyssi limit: | ||||
181 | 2 | 25µs | 2 | 62µs | # spent 34µs (7+28) within Mentat::Storage::Mongo::BEGIN@181 which was called:
# once (7µs+28µs) by main::BEGIN@8 at line 181 # spent 34µs making 1 call to Mentat::Storage::Mongo::BEGIN@181
# spent 28µs making 1 call to constant::import |
182 | |||||
183 | 2 | 37µs | 2 | 58µs | # spent 32µs (6+26) within Mentat::Storage::Mongo::BEGIN@183 which was called:
# once (6µs+26µs) by main::BEGIN@8 at line 183 # spent 32µs making 1 call to Mentat::Storage::Mongo::BEGIN@183
# spent 26µs making 1 call to constant::import |
184 | |||||
185 | #-- Static public class variables (our) ---------------------------------------# | ||||
186 | |||||
187 | #-- Static protected class variables (my) -------------------------------------# | ||||
188 | |||||
189 | #******************************************************************************* | ||||
190 | # INITIALIZATION AND CLEANUP SECTION | ||||
191 | #******************************************************************************* | ||||
192 | |||||
193 | #-- Module initializations ----------------------------------------------------# | ||||
194 | # spent 9µs within Mentat::Storage::Mongo::BEGIN@194 which was called:
# once (9µs+0s) by main::BEGIN@8 at line 199 | ||||
195 | 2 | 36µs | 2 | 82µs | # spent 45µs (7+38) within Mentat::Storage::Mongo::BEGIN@195 which was called:
# once (7µs+38µs) by main::BEGIN@8 at line 195 # spent 45µs making 1 call to Mentat::Storage::Mongo::BEGIN@195
# spent 38µs making 1 call to vars::import |
196 | 3 | 9µs | $VERSION = '0.6'; | ||
197 | $DEVEL = 1; | ||||
198 | @ISA = ('Mentat::Storage'); | ||||
199 | 1 | 1.28ms | 1 | 9µs | } # spent 9µs making 1 call to Mentat::Storage::Mongo::BEGIN@194 |
200 | |||||
201 | |||||
202 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
203 | 1 | 4µs | # spent 2µs within Mentat::Storage::Mongo::END which was called:
# once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl | ||
204 | |||||
205 | } | ||||
206 | |||||
207 | #******************************************************************************* | ||||
208 | # IMPLEMENTATION SECTION | ||||
209 | #******************************************************************************* | ||||
210 | |||||
211 | sub DESTROY | ||||
212 | # spent 149µs (13+136) within Mentat::Storage::Mongo::DESTROY which was called:
# once (13µs+136µs) by main::NULL at line 0 of mentat.storage.mongo.pl | ||||
213 | 3 | 13µs | my $self = shift; | ||
214 | 1 | 2µs | confess "Instance method not invoked on object instance" unless blessed($self); # spent 2µs making 1 call to Scalar::Util::blessed | ||
215 | |||||
216 | 1 | 134µs | $self->disconnect(); # spent 134µs making 1 call to Mentat::Storage::Mongo::disconnect | ||
217 | } | ||||
218 | |||||
219 | =item insert($) [PUBLIC] | ||||
220 | |||||
221 | Usage : my ($record_id, $error) = $storage->insert($object); | ||||
222 | Purpose : Insert the given object into storage | ||||
223 | Arguments : MIXED $object - object to be stored into storage | ||||
224 | Returns : STRING $oid - ID of the inserted object on SUCCESS, undef on FAILURE | ||||
225 | STRING $error - undef on SUCCESS, error string on failure | ||||
226 | Throws : Dies, if not invoked on instance | ||||
227 | Croaks on insert failure | ||||
228 | Comment : This method dies in case of insert failure, it must be taken care | ||||
229 | of on higher levels ! | ||||
230 | Comment : This method attempts to automatically convert given object to hash, | ||||
231 | either using internal convertor (if given upon instantination), or | ||||
232 | using object`s to_hash() method (if defined)! | ||||
233 | |||||
234 | =cut | ||||
235 | |||||
236 | sub insert($) | ||||
237 | { | ||||
238 | my $self = shift; | ||||
239 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
240 | my ($object,) = @_; | ||||
241 | |||||
242 | unless (ref $object eq 'HASH') { | ||||
243 | if ($self->_convertor) { | ||||
244 | $object = $self->_convertor->convert($object); | ||||
245 | } | ||||
246 | elsif (blessed($object) and $object->can('to_hash')) { | ||||
247 | $object = $object->to_hash(); | ||||
248 | } | ||||
249 | } | ||||
250 | |||||
251 | # Try to insert the object into MongoDB | ||||
252 | #Log::Loger->debug(__PACKAGE__, "[MMSM] Inserting object: ".Dumper($object)); | ||||
253 | return $self->{STORAGE}->insert($object, {safe => 1}); | ||||
254 | } | ||||
255 | |||||
256 | =item fetch($) [PUBLIC] | ||||
257 | |||||
258 | Usage : my $object = $storage->fetch($oid); | ||||
259 | Purpose : Fetch the Mentat message with given ID from storage | ||||
260 | Arguments : STRING $oid - unique identifier of the object in storage | ||||
261 | Returns : HASH REFERENCE $object reference on SUCCESS, | ||||
262 | undef if object with given ID was not found, | ||||
263 | Throws : Dies, if not invoked on instance | ||||
264 | Croaks on query failure | ||||
265 | Comments : | ||||
266 | See Also : | ||||
267 | |||||
268 | =cut | ||||
269 | |||||
270 | sub fetch($) | ||||
271 | { | ||||
272 | my $self = shift; | ||||
273 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
274 | my ($oid,) = @_; | ||||
275 | |||||
276 | # Execute query in MongoDB | ||||
277 | my $cursor = $self->{STORAGE}->query({KEY_ID() => $oid})->limit(1); | ||||
278 | |||||
279 | return $cursor->next; | ||||
280 | } | ||||
281 | |||||
282 | =item update($$;$) [PUBLIC] | ||||
283 | |||||
284 | Usage : my $result = $storage->update($filter, $values, $options); | ||||
285 | Purpose : Update the existing object in the storage | ||||
286 | Arguments : HASH REFERENCE $filter - Update filter [MANDATORY] | ||||
287 | HASH REFERENCE $values - Object values [MANDATORY] | ||||
288 | HASH REFERENCE $options - Update options [OPTIONAL] | ||||
289 | Returns : HASH REFERENCE containing information about the operation result: | ||||
290 | ok => success flag | ||||
291 | n => number of affected items | ||||
292 | err => error flag | ||||
293 | Throws : Dies, if not invoked on instance | ||||
294 | |||||
295 | =cut | ||||
296 | |||||
297 | sub update($$;$) | ||||
298 | { | ||||
299 | my $self = shift; | ||||
300 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
301 | my ($filter, $values, $options) = @_; | ||||
302 | |||||
303 | # Modify options so that the update is safe | ||||
304 | $options = ($options && ref $options eq 'HASH')?$options:{}; | ||||
305 | $options->{'safe'} = 1 unless exists $options->{'safe'}; | ||||
306 | |||||
307 | return $self->{STORAGE}->update($filter, $values, $options); | ||||
308 | } | ||||
309 | |||||
310 | =item delete($) [PUBLIC] | ||||
311 | |||||
312 | Usage : my $result = $storage->delete($oid); | ||||
313 | Purpose : Delete the object with given ID from the storage | ||||
314 | Arguments : STRING $oid - unique identifier of the object in storage | ||||
315 | Returns : HASH REFERENCE containing information about the operation result: | ||||
316 | ok => success flag | ||||
317 | n => number of affected items | ||||
318 | err => error flag | ||||
319 | Throws : Dies, if not invoked on instance | ||||
320 | Comments : This operation should always remove only one object | ||||
321 | See Also : For bulk delete operation see remove() method | ||||
322 | |||||
323 | =cut | ||||
324 | |||||
325 | sub delete($) | ||||
326 | { | ||||
327 | my $self = shift; | ||||
328 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
329 | my ($oid,) = @_; | ||||
330 | |||||
331 | return $self->{STORAGE}->remove({KEY_ID() => $oid}, {safe => 1}); | ||||
332 | } | ||||
333 | |||||
334 | =item count(;$) [PUBLIC] | ||||
335 | |||||
336 | Usage : my $count = $storage->count(); or | ||||
337 | my $count = $storage->count($filter); | ||||
338 | Purpose : Get the number of Mentat messages in storage | ||||
339 | Arguments : HASH REFERENCE $filter - Query filter [OPTIONAL] | ||||
340 | Returns : INTEGER on SUCCESS | ||||
341 | Throws : Dies, if not invoked on instance | ||||
342 | Dies on operation failure | ||||
343 | |||||
344 | =cut | ||||
345 | |||||
346 | sub count(;$) | ||||
347 | { | ||||
348 | my $self = shift; | ||||
349 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
350 | my ($filter,) = @_; | ||||
351 | |||||
352 | $self->_set_last_filter('COUNT', $filter); | ||||
353 | |||||
354 | # Unless the filter was explicitly specified, use shortcut | ||||
355 | unless ($filter) { | ||||
356 | return $self->{STORAGE}->count(); | ||||
357 | } | ||||
358 | # Otherwise apply the filter first | ||||
359 | else { | ||||
360 | return $self->{STORAGE}->query($filter)->count(); | ||||
361 | } | ||||
362 | } | ||||
363 | |||||
364 | =item find_i(;$$$$$) [PUBLIC] | ||||
365 | |||||
366 | Usage : my ($objects, $count) = $storage->find_i(); or | ||||
367 | my ($objects, $count) = $storage->find_i($filter); | ||||
368 | Purpose : Find the object(s) according to the given filter and return the cursor to the result | ||||
369 | Arguments : HASH REFERENCE $filter - Query filter [OPTIONAL] | ||||
370 | HASH REFERENCE $selection - Record attribute selection [OPTIONAL] | ||||
371 | HASH REFERENCE $sort - Sorting specification [OPTIONAL] | ||||
372 | INTEGER $limit - Maximum number of records to be returned [OPTIONAL] | ||||
373 | INTEGER $skip - Number of objects to skip from the beginning of the result set [OPTIONAL] | ||||
374 | Returns : ARRAY REFERENCE containing objects | ||||
375 | INTEGER total count of objects | ||||
376 | Throws : Dies, if not invoked on instance | ||||
377 | |||||
378 | =cut | ||||
379 | |||||
380 | sub find_i(;$$$$$) | ||||
381 | # spent 10.5s (66µs+10.5) within Mentat::Storage::Mongo::find_i which was called:
# once (66µs+10.5s) by Mentat::Storage::Mongo::find at line 454 | ||||
382 | 19 | 49µs | my $self = shift; | ||
383 | 1 | 500ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 500ns making 1 call to Scalar::Util::blessed | ||
384 | my ($filter, $projection, $sort, $limit, $skip) = @_; | ||||
385 | die "Received invalid filter as argument\n" if $filter and ref $filter ne 'HASH'; | ||||
386 | |||||
387 | $limit = ($limit) ? int($limit) : 0; | ||||
388 | $skip = ($skip) ? int($skip) : 0; | ||||
389 | 1 | 302µs | $self->_set_last_filter('FIND', $filter, $projection, $sort, $limit, $skip); # spent 302µs making 1 call to Mentat::Storage::Mongo::_set_last_filter | ||
390 | |||||
391 | # Execute the query | ||||
392 | 2 | 34µs | Log::Loger->info(__PACKAGE__, "[MMSM] Executing MongoDB command: ".$self->get_last_filter()); # spent 30µs making 1 call to Log::Loger::info
# spent 5µs making 1 call to Mentat::Storage::Mongo::get_last_filter | ||
393 | |||||
394 | 2 | 136µs | my $cursor = $self->{STORAGE}->find(Tie::IxHash->new(%$filter)); # spent 90µs making 1 call to MongoDB::Collection::find
# spent 47µs making 1 call to Tie::IxHash::new | ||
395 | |||||
396 | # Count the results | ||||
397 | 1 | 18µs | Log::Loger->debug(__PACKAGE__, "[MMSM] Counting results") if $DEVEL; # spent 18µs making 1 call to Log::Loger::debug | ||
398 | 1 | 5.74s | my $count = $cursor->count(); # spent 5.74s making 1 call to MongoDB::Cursor::count | ||
399 | |||||
400 | # Apply the projection | ||||
401 | if ($projection) { | ||||
402 | Log::Loger->debug(__PACKAGE__, "[MMSM] Projecting results") if $DEVEL; | ||||
403 | $cursor = $cursor->fields($projection); | ||||
404 | } | ||||
405 | |||||
406 | # Apply the sorting | ||||
407 | if ($sort) { | ||||
408 | Log::Loger->debug(__PACKAGE__, "[MMSM] Sorting results") if $DEVEL; | ||||
409 | $cursor = $cursor->sort($sort); | ||||
410 | } | ||||
411 | |||||
412 | # Skip few first records | ||||
413 | 1 | 33µs | Log::Loger->debug(__PACKAGE__, "[MMSM] Skiping '$skip' results from beginning") if $DEVEL; # spent 33µs making 1 call to Log::Loger::debug | ||
414 | $cursor = $cursor->skip($skip) if ($skip > 0); | ||||
415 | |||||
416 | # Return limited number of records | ||||
417 | 2 | 4µs | if ($limit > 0) { | ||
418 | 1 | 14µs | Log::Loger->debug(__PACKAGE__, "[MMSM] Limiting results to max '$limit'") if $DEVEL; # spent 14µs making 1 call to Log::Loger::debug | ||
419 | 1 | 20µs | $cursor = $cursor->limit($limit); # spent 20µs making 1 call to MongoDB::Cursor::limit | ||
420 | } | ||||
421 | else { | ||||
422 | Log::Loger->debug(__PACKAGE__, "[MMSM] Results are unlimited") if $DEVEL; | ||||
423 | } | ||||
424 | |||||
425 | # Info about mongodb index | ||||
426 | 1 | 4.73s | $self->_set_last_index($cursor); # spent 4.73s making 1 call to Mentat::Storage::Mongo::_set_last_index | ||
427 | 2 | 42µs | Log::Loger->info(__PACKAGE__, "[MMSM] MongoDB index: ".$self->get_last_index()); # spent 31µs making 1 call to Log::Loger::info
# spent 12µs making 1 call to Mentat::Storage::Mongo::get_last_index | ||
428 | |||||
429 | # Return the result cursor and count | ||||
430 | return ($cursor, $count); | ||||
431 | } | ||||
432 | |||||
433 | =item find(;$$$$$) [PUBLIC] | ||||
434 | |||||
435 | Usage : See the find_i() method for details | ||||
436 | Purpose : Find the object(s) according to the given filter and return them in array | ||||
437 | Arguments : See the find_i() method for details | ||||
438 | Returns : See the find_i() method for details | ||||
439 | Throws : Dies, if not invoked on instance | ||||
440 | |||||
441 | =cut | ||||
442 | |||||
443 | sub find(;$$$$$) | ||||
444 | # spent 12.8s (32µs+12.8) within Mentat::Storage::Mongo::find which was called:
# once (32µs+12.8s) by main::RUNTIME at line 33 of mentat.storage.mongo.pl | ||||
445 | 9 | 19µs | my $self = shift; | ||
446 | 1 | 700ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 700ns making 1 call to Scalar::Util::blessed | ||
447 | my ($filter, $projection, $sort, $limit, $skip) = @_; | ||||
448 | die "Received invalid filter as argument\n" if $filter and ref $filter ne 'HASH'; | ||||
449 | |||||
450 | # Setup some limit, when we are returning all items from database | ||||
451 | $limit = DFLT_LIMIT unless ($limit and (int($limit) > 0)); | ||||
452 | |||||
453 | # Delegate the work to the find() method | ||||
454 | 1 | 10.5s | my ($cursor, $count) = $self->find_i($filter, $projection, $sort, $limit, $skip); # spent 10.5s making 1 call to Mentat::Storage::Mongo::find_i | ||
455 | |||||
456 | # Put all results into the target array | ||||
457 | my @array = (); | ||||
458 | 1 | 15µs | 3 | 4.74s | while (my $doc = $cursor->next) { # spent 2.37s making 1 call to MongoDB::Cursor::next
# spent 2.37s making 1 call to MongoDB::Cursor::_do_query
# spent 3µs making 1 call to MongoDB::Cursor::_limit |
459 | push (@array, $doc); | ||||
460 | } | ||||
461 | return (\@array, $count); | ||||
462 | } | ||||
463 | |||||
464 | =item remove(;$) [PUBLIC] | ||||
465 | |||||
466 | Usage : my $result = $storage->remove(); or | ||||
467 | my $result = $storage->remove($filter); | ||||
468 | Purpose : Remove the objects(s) according to the given filter | ||||
469 | Arguments : HASH REFERENCE $filter - Filter for selecting items to be removed [OPTIONAL] | ||||
470 | Returns : HASH REFERENCE containing information about the operation result: | ||||
471 | ok => success flag | ||||
472 | n => number of affected items | ||||
473 | err => error flag | ||||
474 | Throws : Dies, if not invoked on instance | ||||
475 | Croaks on query failure | ||||
476 | Comments : This operation performs bulk delete operation | ||||
477 | See Also : For single delete operation see delete() method | ||||
478 | Warning : DELETES ALL DATA, IF GIVEN NO FILTER !!! | ||||
479 | |||||
480 | =cut | ||||
481 | |||||
482 | sub remove(;$) | ||||
483 | { | ||||
484 | my $self = shift; | ||||
485 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
486 | my ($filter,) = @_; | ||||
487 | |||||
488 | $self->_set_last_filter('REMOVE', $filter); | ||||
489 | |||||
490 | return $self->{STORAGE}->remove($filter, {safe => 1}); | ||||
491 | } | ||||
492 | |||||
493 | =item aggregate [PUBLIC] | ||||
494 | |||||
495 | Usage : my $result = $storage->aggregate(@_); | ||||
496 | Purpose : Call the aggregate operation on internal storage | ||||
497 | Arguments : Same as MongoDB::Collection::aggregate() method | ||||
498 | Returns : Same as MongoDB::Collection::aggregate() method | ||||
499 | Throws : Dies, if invoked on class | ||||
500 | See Also : MongoDB::Collection::aggregate() method for more details | ||||
501 | |||||
502 | =cut | ||||
503 | |||||
504 | sub aggregate | ||||
505 | { | ||||
506 | my $self = shift; | ||||
507 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
508 | |||||
509 | Log::Loger->info(__PACKAGE__, "[MMSM] Executing MongoDB aggregate: ".Dumper (@_)); | ||||
510 | return $self->{STORAGE}->aggregate(@_); | ||||
511 | } | ||||
512 | |||||
513 | =item run_command [PUBLIC] | ||||
514 | |||||
515 | Usage : my $result = $storage->run_command(@_); | ||||
516 | Purpose : Call the specific operation on internal storage | ||||
517 | Arguments : Same as MongoDB::Database::run_command() method | ||||
518 | Returns : Same as MongoDB::Database::run_command() method | ||||
519 | Throws : Dies, if invoked on class | ||||
520 | See Also : MongoDB::Database::run_command() method for more details | ||||
521 | |||||
522 | =cut | ||||
523 | |||||
524 | sub run_command | ||||
525 | { | ||||
526 | my $self = shift; | ||||
527 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
528 | |||||
529 | Log::Loger->info(__PACKAGE__, "[MMSM] Executing MongoDB run_command: ".Dumper (@_)); | ||||
530 | return $self->{DATABASE}->run_command(@_); | ||||
531 | } | ||||
532 | |||||
533 | =item disconnect() [PUBLIC,ABSTRACT] | ||||
534 | |||||
535 | Usage : $storage->disconnect(); | ||||
536 | Purpose : Close existing storage connection | ||||
537 | Arguments : NONE | ||||
538 | Returns : UNDEF on SUCCESS, STRING $error on FAILURE | ||||
539 | Throws : Dies, if not invoked on instance | ||||
540 | |||||
541 | =cut | ||||
542 | |||||
543 | sub disconnect() | ||||
544 | # spent 134µs (27+107) within Mentat::Storage::Mongo::disconnect which was called:
# once (27µs+107µs) by Mentat::Storage::Mongo::DESTROY at line 216 | ||||
545 | 3 | 5µs | my $self = shift; | ||
546 | 1 | 500ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 500ns making 1 call to Scalar::Util::blessed | ||
547 | |||||
548 | 4 | 18µs | if ($self->{CONNECTION}) { | ||
549 | $self->{STORAGE} = undef; | ||||
550 | 1 | 2µs | 1 | 7µs | $self->{DATABASE} = undef; # spent 7µs making 1 call to MongoDB::Collection::DESTROY |
551 | 1 | 1µs | 1 | 6µs | $self->{CONNECTION} = undef; # spent 6µs making 1 call to MongoDB::Database::DESTROY |
552 | |||||
553 | 1 | 1µs | 1 | 94µs | return undef; # spent 94µs making 1 call to Moose::Object::DESTROY |
554 | } | ||||
555 | else { | ||||
556 | return "Connection was already closed"; | ||||
557 | } | ||||
558 | } | ||||
559 | |||||
560 | =item reconnect() [PUBLIC] | ||||
561 | |||||
562 | Usage : $storage->reconnect(); | ||||
563 | Purpose : Optionally close existing storage connection and reopen it | ||||
564 | Arguments : NONE | ||||
565 | Returns : UNDEF on SUCCESS, STRING $error on FAILURE | ||||
566 | Throws : Dies, if not invoked on instance | ||||
567 | |||||
568 | =cut | ||||
569 | |||||
570 | sub reconnect() | ||||
571 | # spent 8.80ms (22µs+8.78) within Mentat::Storage::Mongo::reconnect which was called:
# once (22µs+8.78ms) by Mentat::Storage::Mongo::_init at line 760 | ||||
572 | 8 | 16µs | my $self = shift; | ||
573 | 1 | 600ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 600ns making 1 call to Scalar::Util::blessed | ||
574 | |||||
575 | # Disconnect first, if connection already exists | ||||
576 | $self->disconnect() if ($self->{CONNECTION}); | ||||
577 | |||||
578 | # Open new connection | ||||
579 | 1 | 600ns | 1 | 8.68ms | $self->{CONNECTION} = MongoDB::Connection->new('w' => 1, @{$self->{CFG_CONNECTION}}); # spent 8.68ms making 1 call to MongoDB::Connection::new |
580 | 1 | 35µs | $self->{CONNECTION}->query_timeout($self->{CFG_QUERY_TIMEOUT}); # spent 35µs making 1 call to MongoDB::Connection::query_timeout | ||
581 | |||||
582 | # Select database | ||||
583 | 1 | 40µs | $self->{DATABASE} = $self->{CONNECTION}->get_database($self->{CFG_DATABASE}); # spent 40µs making 1 call to MongoDB::Connection::get_database | ||
584 | |||||
585 | # Connect to speciffic collection | ||||
586 | 1 | 20µs | $self->{STORAGE} = $self->{DATABASE}->get_collection($self->{CFG_COLLECTION}); # spent 20µs making 1 call to MongoDB::Database::get_collection | ||
587 | |||||
588 | return undef; | ||||
589 | } | ||||
590 | |||||
591 | =item get_last_filter() [PUBLIC] | ||||
592 | |||||
593 | Usage : | ||||
594 | Purpose : | ||||
595 | Arguments : | ||||
596 | Returns : | ||||
597 | Throws : Dies, if not invoked on instance | ||||
598 | Comments : | ||||
599 | See Also : | ||||
600 | |||||
601 | =cut | ||||
602 | |||||
603 | sub get_last_filter() | ||||
604 | # spent 5µs (4+500ns) within Mentat::Storage::Mongo::get_last_filter which was called:
# once (4µs+500ns) by Mentat::Storage::Mongo::find_i at line 392 | ||||
605 | 4 | 7µs | my $self = shift; | ||
606 | 1 | 500ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 500ns making 1 call to Scalar::Util::blessed | ||
607 | my ($filter, $sort, $limit, $skip) = @_; | ||||
608 | |||||
609 | return $self->{LAST_FILTER}; | ||||
610 | } | ||||
611 | |||||
612 | =item get_last_index(;$) [PUBLIC] | ||||
613 | |||||
614 | Usage : | ||||
615 | Purpose : | ||||
616 | Arguments : INTEGER $verbose - [OPTIONAL] | ||||
617 | Returns : | ||||
618 | Throws : Dies, if not invoked on instance | ||||
619 | Comments : | ||||
620 | See Also : | ||||
621 | |||||
622 | =cut | ||||
623 | |||||
624 | sub get_last_index(;$) | ||||
625 | # spent 12µs (9+3) within Mentat::Storage::Mongo::get_last_index which was called:
# once (9µs+3µs) by Mentat::Storage::Mongo::find_i at line 427 | ||||
626 | 4 | 12µs | my $self = shift; | ||
627 | 1 | 3µs | confess "Instance method not invoked on object instance" unless blessed($self); # spent 3µs making 1 call to Scalar::Util::blessed | ||
628 | my ($verbose) = @_; | ||||
629 | |||||
630 | return ($verbose)?$self->_encode2json($self->{LAST_INDEX}):$self->{LAST_INDEX}->{cursor}; | ||||
631 | } | ||||
632 | |||||
633 | =item cursor_iterate($$;$) [PUBLIC] | ||||
634 | |||||
635 | Usage : | ||||
636 | Purpose : | ||||
637 | Arguments : MongoDB::Cursor $cursor - [MANDATORY] | ||||
638 | CODEREF $cb - [MANDATORY] | ||||
639 | INTEGER $limit - [OPTIONAL] | ||||
640 | Returns : | ||||
641 | Throws : Dies, if not invoked on instance | ||||
642 | Comments : | ||||
643 | See Also : | ||||
644 | |||||
645 | =cut | ||||
646 | |||||
647 | sub cursor_iterate($$;$) | ||||
648 | { | ||||
649 | my $self = shift; | ||||
650 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
651 | my ($cursor, $cb, $limit) = @_; | ||||
652 | die "Valid database cursor must be given as argument, received: ".blessed($cursor)."\n" unless blessed($cursor) and blessed($cursor) eq 'MongoDB::Cursor'; | ||||
653 | die "Valid callback must be given as argument\n" unless ref $cb and ref $cb eq 'CODE'; | ||||
654 | |||||
655 | 2 | 904µs | 2 | 31µs | # spent 19µs (8+11) within Mentat::Storage::Mongo::BEGIN@655 which was called:
# once (8µs+11µs) by main::BEGIN@8 at line 655 # spent 19µs making 1 call to Mentat::Storage::Mongo::BEGIN@655
# spent 11µs making 1 call to strict::unimport |
656 | my $i = 0; | ||||
657 | while (my $doc = $cursor->next) { | ||||
658 | ++$i; | ||||
659 | &{$cb}($doc); | ||||
660 | last if $limit and $i >= $limit; | ||||
661 | } | ||||
662 | return $i; | ||||
663 | } | ||||
664 | |||||
665 | =item list_collections() [PUBLIC] | ||||
666 | |||||
667 | Usage : | ||||
668 | Purpose : | ||||
669 | Arguments : | ||||
670 | Returns : | ||||
671 | Throws : Dies, if not invoked on instance | ||||
672 | Comments : | ||||
673 | See Also : | ||||
674 | |||||
675 | =cut | ||||
676 | |||||
677 | sub list_collections() | ||||
678 | { | ||||
679 | my $self = shift; | ||||
680 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
681 | |||||
682 | # Connect to speciffic collection | ||||
683 | return $self->{DATABASE}->collection_names(); | ||||
684 | } | ||||
685 | |||||
686 | =item list_indexes() [PUBLIC] | ||||
687 | |||||
688 | Usage : | ||||
689 | Purpose : | ||||
690 | Arguments : | ||||
691 | Returns : | ||||
692 | Throws : Dies, if not invoked on instance | ||||
693 | Comments : | ||||
694 | See Also : | ||||
695 | |||||
696 | =cut | ||||
697 | |||||
698 | sub list_indexes() | ||||
699 | { | ||||
700 | my $self = shift; | ||||
701 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
702 | |||||
703 | # Connect to speciffic collection | ||||
704 | return $self->{STORAGE}->get_indexes(); | ||||
705 | } | ||||
706 | |||||
707 | =item change_collection($) [PUBLIC] | ||||
708 | |||||
709 | Usage : | ||||
710 | Purpose : | ||||
711 | Arguments : STRING $collection - [MANDATORY] | ||||
712 | Returns : | ||||
713 | Throws : Dies, if not invoked on instance | ||||
714 | Comments : | ||||
715 | See Also : | ||||
716 | |||||
717 | =cut | ||||
718 | |||||
719 | sub change_collection($) | ||||
720 | { | ||||
721 | my $self = shift; | ||||
722 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
723 | my ($collection,) = @_; | ||||
724 | |||||
725 | # Connect to speciffic collection | ||||
726 | $self->{STORAGE} = $self->{DATABASE}->get_collection($collection); | ||||
727 | $self->{CFG_COLLECTION} = $collection; | ||||
728 | } | ||||
729 | |||||
730 | #------------------------------------------------------------------------------- | ||||
731 | |||||
732 | # _init [PROTECTED] | ||||
733 | # | ||||
734 | # Usage : | ||||
735 | # Purpose : | ||||
736 | # Arguments : | ||||
737 | # Returns : | ||||
738 | # Throws : Dies, if not invoked on instance | ||||
739 | # Comments : | ||||
740 | # See Also : | ||||
741 | |||||
742 | sub _init | ||||
743 | # spent 8.83ms (14µs+8.81) within Mentat::Storage::Mongo::_init which was called:
# once (14µs+8.81ms) by Mentat::Storage::new at line 113 of Mentat/Storage.pm | ||||
744 | 12 | 13µs | my $self = shift; | ||
745 | 1 | 700ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 700ns making 1 call to Scalar::Util::blessed | ||
746 | my %params = (@_) ? @_ : (); | ||||
747 | confess "Database name must be given as argument" unless $params{database}; | ||||
748 | confess "Collection name must be given as argument" unless $params{collection}; | ||||
749 | |||||
750 | # Store the connection parameters | ||||
751 | $self->{CFG_CONNECTION} = $params{connection}; | ||||
752 | $self->{CFG_DATABASE} = $params{database}; | ||||
753 | $self->{CFG_COLLECTION} = $params{collection}; | ||||
754 | $self->{CFG_QUERY_TIMEOUT} = $params{query_timeout} || DFLT_TIMEOUT(); | ||||
755 | |||||
756 | # Register the optional convertor | ||||
757 | 1 | 15µs | $self->_convertor($params{convertor}); # spent 15µs making 1 call to Mentat::Storage::Mongo::_convertor | ||
758 | |||||
759 | # Open the connection | ||||
760 | 1 | 8.80ms | $self->reconnect(); # spent 8.80ms making 1 call to Mentat::Storage::Mongo::reconnect | ||
761 | |||||
762 | return $self; | ||||
763 | } | ||||
764 | |||||
765 | # _create_indexes(@) [PROTECTED] | ||||
766 | # | ||||
767 | # Usage : | ||||
768 | # Purpose : | ||||
769 | # Arguments : | ||||
770 | # Returns : | ||||
771 | # Throws : Dies, if not invoked on instance | ||||
772 | # Comments : | ||||
773 | # See Also : | ||||
774 | |||||
775 | sub _create_indexes(@) | ||||
776 | { | ||||
777 | my $self = shift; | ||||
778 | confess "Instance method not invoked on object instance" unless blessed($self); | ||||
779 | my @indexes = @_; | ||||
780 | |||||
781 | foreach my $i (@indexes) { | ||||
782 | $self->{STORAGE}->ensure_index(@$i); | ||||
783 | } | ||||
784 | } | ||||
785 | |||||
786 | # _convertor(;$) [PROTECTED] | ||||
787 | # | ||||
788 | # Usage : | ||||
789 | # Purpose : | ||||
790 | # Arguments : | ||||
791 | # Returns : | ||||
792 | # Throws : Dies, if not invoked on instance | ||||
793 | # Comments : | ||||
794 | # See Also : | ||||
795 | |||||
796 | sub _convertor(;$) | ||||
797 | # spent 15µs (15+600ns) within Mentat::Storage::Mongo::_convertor which was called:
# once (15µs+600ns) by Mentat::Storage::Mongo::_init at line 757 | ||||
798 | 5 | 18µs | my $self = shift; | ||
799 | 1 | 600ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 600ns making 1 call to Scalar::Util::blessed | ||
800 | my ($convertor,) = @_; | ||||
801 | |||||
802 | if ($convertor) { | ||||
803 | if (blessed($convertor) and $convertor->can('convert')) { | ||||
804 | $self->{CONVERTOR} = $convertor; | ||||
805 | } | ||||
806 | else { | ||||
807 | confess "Received invalid database object convertor"; | ||||
808 | } | ||||
809 | } | ||||
810 | return $self->{CONVERTOR}; | ||||
811 | } | ||||
812 | |||||
813 | # _set_last_index(;$) [PROTECTED] | ||||
814 | # | ||||
815 | # Usage : | ||||
816 | # Purpose : | ||||
817 | # Arguments : | ||||
818 | # Returns : | ||||
819 | # Throws : Dies, if not invoked on instance | ||||
820 | # Comments : | ||||
821 | # See Also : | ||||
822 | |||||
823 | sub _set_last_index(;$) | ||||
824 | # spent 4.73s (12µs+4.73) within Mentat::Storage::Mongo::_set_last_index which was called:
# once (12µs+4.73s) by Mentat::Storage::Mongo::find_i at line 426 | ||||
825 | 5 | 12µs | my $self = shift; | ||
826 | 1 | 800ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 800ns making 1 call to Scalar::Util::blessed | ||
827 | my ($cursor) = @_; | ||||
828 | |||||
829 | 1 | 4.73s | $self->{LAST_INDEX} = $cursor->explain; # spent 4.73s making 1 call to MongoDB::Cursor::explain | ||
830 | |||||
831 | return $self; | ||||
832 | } | ||||
833 | |||||
834 | # _set_last_filter(;$$$$$$) [PROTECTED] | ||||
835 | # | ||||
836 | # Usage : | ||||
837 | # Purpose : | ||||
838 | # Arguments : | ||||
839 | # Returns : | ||||
840 | # Throws : Dies, if not invoked on instance | ||||
841 | # Comments : | ||||
842 | # See Also : | ||||
843 | |||||
844 | sub _set_last_filter(;$$$$$$) | ||||
845 | # spent 302µs (16+286) within Mentat::Storage::Mongo::_set_last_filter which was called:
# once (16µs+286µs) by Mentat::Storage::Mongo::find_i at line 389 | ||||
846 | 13 | 14µs | my $self = shift; | ||
847 | 1 | 600ns | confess "Instance method not invoked on object instance" unless blessed($self); # spent 600ns making 1 call to Scalar::Util::blessed | ||
848 | my ($type, $filter, $projection, $sort, $limit, $skip) = @_; | ||||
849 | |||||
850 | $self->{LAST_FILTER} = 'ERROR'; | ||||
851 | |||||
852 | 1 | 276µs | my $fstr = $self->_encode2json($filter); # spent 276µs making 1 call to Mentat::Storage::Mongo::_encode2json | ||
853 | 1 | 5µs | my $pstr = $self->_encode2json($projection); # spent 5µs making 1 call to Mentat::Storage::Mongo::_encode2json | ||
854 | 1 | 4µs | my $sstr = $self->_encode2json($sort); # spent 4µs making 1 call to Mentat::Storage::Mongo::_encode2json | ||
855 | |||||
856 | $self->{LAST_FILTER} = "[$type] Filter '$fstr'"; | ||||
857 | $self->{LAST_FILTER} .= " with projection '$pstr'" if $pstr; | ||||
858 | $self->{LAST_FILTER} .= " with sorting '$sstr'" if $sstr; | ||||
859 | $self->{LAST_FILTER} .= " with limit '$limit'" if $limit; | ||||
860 | $self->{LAST_FILTER} .= " with skip '$skip'" if $skip; | ||||
861 | return $self; | ||||
862 | } | ||||
863 | |||||
864 | # _encode2json($) [PROTECTED] | ||||
865 | # | ||||
866 | # Usage : my $json = $self->_encode2json($anything); | ||||
867 | # Purpose : Encode given object structure to JSON string | ||||
868 | # Arguments : MIXED $anything - any argument [MANDATORY] | ||||
869 | # Returns : STRING $json | ||||
870 | # Throws : Dies, if not invoked on instance | ||||
871 | # Comments : Internally uses _unbless() method to stringify blessed references | ||||
872 | # See Also : _unbless() method | ||||
873 | |||||
874 | sub _encode2json($) | ||||
875 | # spent 286µs (31+254) within Mentat::Storage::Mongo::_encode2json which was called 3 times, avg 95µs/call:
# once (23µs+253µs) by Mentat::Storage::Mongo::_set_last_filter at line 852
# once (5µs+600ns) by Mentat::Storage::Mongo::_set_last_filter at line 853
# once (4µs+400ns) by Mentat::Storage::Mongo::_set_last_filter at line 854 | ||||
876 | 21 | 27µs | my $self = shift; | ||
877 | 3 | 2µs | confess "Instance method not invoked on object instance" unless blessed($self); # spent 2µs making 3 calls to Scalar::Util::blessed, avg 533ns/call | ||
878 | my ($hash,) = @_; | ||||
879 | |||||
880 | my ($hash_json, $tmp); | ||||
881 | 3 | 27µs | eval { | ||
882 | 1 | 22µs | $hash_json = ($hash)?encode_json($hash):''; # spent 22µs making 1 call to JSON::XS::encode_json | ||
883 | }; | ||||
884 | 3 | 36µs | 1 | 5µs | if ($@ and $@ =~ /allow_blessed|convert_blessed/) { # spent 5µs making 1 call to Mentat::Storage::Mongo::CORE:match |
885 | 1 | 24µs | $tmp = clone($hash); # spent 24µs making 1 call to Clone::clone | ||
886 | 1 | 199µs | $tmp = $self->_unbless($tmp); # spent 199µs making 1 call to Mentat::Storage::Mongo::_unbless | ||
887 | 1 | 4µs | $hash_json = encode_json($tmp); # spent 4µs making 1 call to JSON::XS::encode_json | ||
888 | } | ||||
889 | return $hash_json; | ||||
890 | } | ||||
891 | |||||
892 | # _unbless($) [PROTECTED] | ||||
893 | # | ||||
894 | # Usage : my $result = $self->_unbless($anything); | ||||
895 | # Purpose : Replace all blessed objects in given data structure | ||||
896 | # Arguments : MIXED $anything - any argument [MANDATORY] | ||||
897 | # Returns : HASHREF $result | ||||
898 | # Throws : Dies, if not invoked on instance | ||||
899 | # Comments : VERY UGLY HACK TO ALLOW PRINTING THE RAW MONGODB QUERY, FIXME | ||||
900 | |||||
901 | sub _unbless($) | ||||
902 | { | ||||
903 | 15 | 11µs | my $self = shift; | ||
904 | 3 | 2µs | confess "Instance method not invoked on object instance" unless blessed($self); # spent 2µs making 3 calls to Scalar::Util::blessed, avg 633ns/call | ||
905 | my ($filter,) = @_; | ||||
906 | |||||
907 | # Deal with scalar values immediately, but this should not be necessary now | ||||
908 | return $filter unless ref $filter; | ||||
909 | |||||
910 | # Alter the values within HASH | ||||
911 | 9 | 12µs | if (ref $filter eq "HASH") { | ||
912 | my $t; | ||||
913 | foreach my $key (keys(%$filter)) { | ||||
914 | 10 | 20µs | 5 | 3µs | $t = blessed($filter->{$key}); # spent 3µs making 5 calls to Scalar::Util::blessed, avg 640ns/call |
915 | # MongoDB::BSON::Binary is tricky to display, use HEX for now | ||||
916 | 4 | 19µs | 2 | 110µs | if ($t and ($t eq 'MongoDB::BSON::Binary')) { # spent 110µs making 2 calls to Moose::Object::DESTROY, avg 55µs/call |
917 | 4 | 21µs | $filter->{$key} = 'HexData(0,"'.Value::Convertor->bin_to_hexstr($filter->{$key}->data).'")'; # spent 16µs making 2 calls to Value::Convertor::bin_to_hexstr, avg 8µs/call
# spent 5µs making 2 calls to MongoDB::BSON::Binary::data, avg 2µs/call | ||
918 | } | ||||
919 | # Math:BigInt has method bstr(), use it | ||||
920 | elsif ($t and ($t eq 'Math::BigInt')) { | ||||
921 | $filter->{$key} = 'NumberLong('.$filter->{$key}->bstr().')'; | ||||
922 | } | ||||
923 | # This will attempt to stringify any other object | ||||
924 | elsif ($t) { | ||||
925 | $filter->{$key} = "".$filter->{$key}; | ||||
926 | } | ||||
927 | # Recursion for HASHES and ARRAYS | ||||
928 | elsif (ref $filter->{$key}) { | ||||
929 | 2 | 0s | $filter->{$key} = $self->_unbless($filter->{$key}); # spent 175µs making 2 calls to Mentat::Storage::Mongo::_unbless, avg 88µs/call, recursion: max depth 1, sum of overlapping time 175µs | ||
930 | } | ||||
931 | } | ||||
932 | return $filter; | ||||
933 | } | ||||
934 | # Alter the values within array | ||||
935 | elsif (ref $filter eq "ARRAY") { | ||||
936 | my $result = []; | ||||
937 | foreach my $key (@$filter) { | ||||
938 | # Shortcut for scalar values | ||||
939 | unless (ref $key) { | ||||
940 | push(@$result, $key); | ||||
941 | } | ||||
942 | # Recursively unbless everything else | ||||
943 | else { | ||||
944 | push(@$result, $self->_unbless($key)); | ||||
945 | } | ||||
946 | } | ||||
947 | return $result; | ||||
948 | } | ||||
949 | # Fallback, this should never happen, but attempt to stringify any other object | ||||
950 | else { | ||||
951 | return "$filter"; | ||||
952 | } | ||||
953 | } | ||||
954 | |||||
955 | =pod | ||||
956 | |||||
957 | =back | ||||
958 | |||||
959 | =cut | ||||
960 | |||||
961 | 1 | 2µs | 1; | ||
# spent 5µs within Mentat::Storage::Mongo::CORE:match which was called:
# once (5µs+0s) by Mentat::Storage::Mongo::_encode2json at line 884 |