← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 09:58:41 2014
Reported on Tue Jun 24 09:59:13 2014

Filename/usr/local/lib/perl/5.14.2/MongoDB/Collection.pm
StatementsExecuted 71 statements in 2.12ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
32246µs302µsMongoDB::Collection::::findMongoDB::Collection::find
31124µs35µsMongoDB::Collection::::_build_full_nameMongoDB::Collection::_build_full_name
21123µs5.74sMongoDB::Collection::::find_oneMongoDB::Collection::find_one
11110µs42µsMongoDB::Collection::::BEGIN@29MongoDB::Collection::BEGIN@29
1119µs9µsMongoDB::Collection::::BEGIN@26MongoDB::Collection::BEGIN@26
1117µs32µsMongoDB::Collection::::BEGIN@28MongoDB::Collection::BEGIN@28
1117µs2.84msMongoDB::Collection::::BEGIN@27MongoDB::Collection::BEGIN@27
0000s0sMongoDB::Collection::::AUTOLOADMongoDB::Collection::AUTOLOAD
0000s0sMongoDB::Collection::::_make_safeMongoDB::Collection::_make_safe
0000s0sMongoDB::Collection::::aggregateMongoDB::Collection::aggregate
0000s0sMongoDB::Collection::::batch_insertMongoDB::Collection::batch_insert
0000s0sMongoDB::Collection::::countMongoDB::Collection::count
0000s0sMongoDB::Collection::::dropMongoDB::Collection::drop
0000s0sMongoDB::Collection::::drop_indexMongoDB::Collection::drop_index
0000s0sMongoDB::Collection::::drop_indexesMongoDB::Collection::drop_indexes
0000s0sMongoDB::Collection::::ensure_indexMongoDB::Collection::ensure_index
0000s0sMongoDB::Collection::::find_and_modifyMongoDB::Collection::find_and_modify
0000s0sMongoDB::Collection::::get_collectionMongoDB::Collection::get_collection
0000s0sMongoDB::Collection::::get_indexesMongoDB::Collection::get_indexes
0000s0sMongoDB::Collection::::insertMongoDB::Collection::insert
0000s0sMongoDB::Collection::::queryMongoDB::Collection::query
0000s0sMongoDB::Collection::::removeMongoDB::Collection::remove
0000s0sMongoDB::Collection::::renameMongoDB::Collection::rename
0000s0sMongoDB::Collection::::saveMongoDB::Collection::save
0000s0sMongoDB::Collection::::to_index_stringMongoDB::Collection::to_index_string
0000s0sMongoDB::Collection::::updateMongoDB::Collection::update
0000s0sMongoDB::Collection::::validateMongoDB::Collection::validate
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1#
2# Copyright 2009-2013 MongoDB, Inc.
3#
4# Licensed under the Apache License, Version 2.0 (the "License");
5# you may not use this file except in compliance with the License.
6# You may obtain a copy of the License at
7#
8# http://www.apache.org/licenses/LICENSE-2.0
9#
10# Unless required by applicable law or agreed to in writing, software
11# distributed under the License is distributed on an "AS IS" BASIS,
12# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13# See the License for the specific language governing permissions and
14# limitations under the License.
15#
16
17package MongoDB::Collection;
18{
1921µs $MongoDB::Collection::VERSION = '0.702.2';
20}
21
22
23# ABSTRACT: A MongoDB Collection
24
25
26224µs19µs
# spent 9µs within MongoDB::Collection::BEGIN@26 which was called: # once (9µs+0s) by MongoDB::BEGIN@31 at line 26
use Tie::IxHash;
# spent 9µs making 1 call to MongoDB::Collection::BEGIN@26
27234µs25.68ms
# spent 2.84ms (7µs+2.84) within MongoDB::Collection::BEGIN@27 which was called: # once (7µs+2.84ms) by MongoDB::BEGIN@31 at line 27
use Moose;
# spent 2.84ms making 1 call to MongoDB::Collection::BEGIN@27 # spent 2.84ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:519]
28224µs257µs
# spent 32µs (7+25) within MongoDB::Collection::BEGIN@28 which was called: # once (7µs+25µs) by MongoDB::BEGIN@31 at line 28
use Carp 'carp';
# spent 32µs making 1 call to MongoDB::Collection::BEGIN@28 # spent 25µs making 1 call to Exporter::import
2921.87ms247µs
# spent 42µs (10+32) within MongoDB::Collection::BEGIN@29 which was called: # once (10µs+32µs) by MongoDB::BEGIN@31 at line 29
use boolean;
# spent 42µs making 1 call to MongoDB::Collection::BEGIN@29 # spent 5µs making 1 call to boolean::import
30
3112µs11.51mshas _database => (
# spent 1.51ms making 1 call to Moose::has
32 is => 'ro',
33 isa => 'MongoDB::Database',
34 required => 1,
35);
36
37
3811µs11.49mshas name => (
# spent 1.49ms making 1 call to Moose::has
39 is => 'ro',
40 isa => 'Str',
41 required => 1,
42);
43
4412µs12.07mshas full_name => (
# spent 2.07ms making 1 call to Moose::has
45 is => 'ro',
46 isa => 'Str',
47 lazy => 1,
48 builder => '_build_full_name',
49);
50
51
# spent 35µs (24+11) within MongoDB::Collection::_build_full_name which was called 3 times, avg 12µs/call: # 3 times (24µs+11µs) by MongoDB::Collection::full_name at line 12 of (eval 62)[Eval/Closure.pm:144], avg 12µs/call
sub _build_full_name {
521218µs my ($self) = @_;
5334µs my $name = $self->name;
# spent 4µs making 3 calls to MongoDB::Collection::name, avg 1µs/call
5467µs my $db_name = $self->_database->name;
# spent 4µs making 3 calls to MongoDB::Database::name, avg 1µs/call # spent 3µs making 3 calls to MongoDB::Collection::_database, avg 1µs/call
55 return "${db_name}.${name}";
56}
57
58
59sub AUTOLOAD {
60 my $self = shift @_;
61 our $AUTOLOAD;
62
63 my $coll = $AUTOLOAD;
64 $coll =~ s/.*:://;
65
66 carp sprintf q{AUTOLOADed collection method names are deprecated and will be removed in a future release. Use $collection->get_collection( '%s' ) instead.}, $coll;
67
68 return $self->get_collection($coll);
69}
70
71
72sub get_collection {
73 my $self = shift @_;
74 my $coll = shift @_;
75
76 return $self->_database->get_collection($self->name.'.'.$coll);
77}
78
79sub to_index_string {
80 my $keys = shift;
81
82 my @name;
83 if (ref $keys eq 'ARRAY') {
84 @name = @$keys;
85 }
86 elsif (ref $keys eq 'HASH' ) {
87 @name = %$keys
88 }
89 elsif (ref $keys eq 'Tie::IxHash') {
90 my @ks = $keys->Keys;
91 my @vs = $keys->Values;
92
93 for (my $i=0; $i<$keys->Length; $i++) {
94 push @name, $ks[$i];
95 push @name, $vs[$i];
96 }
97 }
98 else {
99 confess 'expected Tie::IxHash, hash, or array reference for keys';
100 }
101
102 return join("_", @name);
103}
104
105
106
# spent 302µs (46+256) within MongoDB::Collection::find which was called 3 times, avg 101µs/call: # 2 times (33µs+180µs) by MongoDB::Collection::find_one at line 144, avg 106µs/call # once (14µs+76µs) by Mentat::Storage::Mongo::find_i at line 394 of Mentat/Storage/Mongo.pm
sub find {
1073647µs my ($self, $query, $attrs) = @_;
108 # old school options - these should be set with MongoDB::Cursor methods
109 my ($limit, $skip, $sort_by) = @{ $attrs || {} }{qw/limit skip sort_by/};
110
111 $limit ||= 0;
112 $skip ||= 0;
113
114 my $q = $query || {};
11569µs my $conn = $self->_database->_client;
# spent 5µs making 3 calls to MongoDB::Collection::_database, avg 2µs/call # spent 4µs making 3 calls to MongoDB::Database::_client, avg 1µs/call
116367µs my $ns = $self->full_name;
# spent 67µs making 3 calls to MongoDB::Collection::full_name, avg 22µs/call
1173174µs my $cursor = MongoDB::Cursor->new(
# spent 174µs making 3 calls to MongoDB::Cursor::new, avg 58µs/call
118 _client => $conn,
119 _ns => $ns,
120 _query => $q,
121 _limit => $limit,
122 _skip => $skip
123 );
124
12536µs $cursor->_init;
# spent 6µs making 3 calls to MongoDB::Cursor::_init, avg 2µs/call
126 if ($sort_by) {
127 $cursor->sort($sort_by);
128 }
129 return $cursor;
130}
131
132sub query {
133 my ($self, $query, $attrs) = @_;
134
135 return $self->find($query, $attrs);
136}
137
138
139
# spent 5.74s (23µs+5.74) within MongoDB::Collection::find_one which was called 2 times, avg 2.87s/call: # 2 times (23µs+5.74s) by MongoDB::Database::run_command at line 109 of MongoDB/Database.pm, avg 2.87s/call
sub find_one {
140815µs my ($self, $query, $fields) = @_;
141 $query ||= {};
142 $fields ||= {};
143
144166µs1911.5s return $self->find($query)->limit(-1)->fields($fields)->next;
# spent 5.74s making 2 calls to MongoDB::Cursor::next, avg 2.87s/call # spent 5.74s making 2 calls to MongoDB::Cursor::_do_query, avg 2.87s/call # spent 213µs making 2 calls to MongoDB::Collection::find, avg 106µs/call # spent 34µs making 2 calls to MongoDB::Cursor::limit, avg 17µs/call # spent 32µs making 2 calls to MongoDB::Cursor::_dt_type, avg 16µs/call # spent 22µs making 2 calls to MongoDB::Cursor::fields, avg 11µs/call # spent 19µs making 2 calls to MongoDB::Cursor::_inflate_dbrefs, avg 10µs/call # spent 4µs making 2 calls to MongoDB::Cursor::_limit, avg 2µs/call # spent 2µs making 2 calls to MongoDB::Cursor::_client, avg 1µs/call # spent 2µs making 1 call to boolean::false
145}
146
147
148sub insert {
149 my ($self, $object, $options) = @_;
150 my ($id) = $self->batch_insert([$object], $options);
151
152 return $id;
153}
154
155
156sub batch_insert {
157 my ($self, $object, $options) = @_;
158 confess 'not an array reference' unless ref $object eq 'ARRAY';
159
160 my $add_ids = 1;
161 if ($options->{'no_ids'}) {
162 $add_ids = 0;
163 }
164
165 my $conn = $self->_database->_client;
166 my $ns = $self->full_name;
167
168 my ($insert, $ids) = MongoDB::write_insert($ns, $object, $add_ids);
169 if (length($insert) > $conn->max_bson_size) {
170 Carp::croak("insert is too large: ".length($insert)." max: ".$conn->max_bson_size);
171 return 0;
172 }
173
174 if ( ( defined($options) && $options->{safe} ) or $conn->_w_want_safe ) {
175 my $ok = $self->_make_safe($insert);
176
177 if (!$ok) {
178 return 0;
179 }
180 }
181 else {
182 $conn->send($insert);
183 }
184
185 return $ids ? @$ids : $ids;
186}
187
188
189sub update {
190 my ($self, $query, $object, $opts) = @_;
191
192 # there used to be one option: upsert=0/1
193 # now there are two, there will probably be
194 # more in the future. So, to support old code,
195 # passing "1" will still be supported, but not
196 # documentd, so we can phase that out eventually.
197 #
198 # The preferred way of passing options will be a
199 # hash of {optname=>value, ...}
200 my $flags = 0;
201 if ($opts && ref $opts eq 'HASH') {
202 $flags |= $opts->{'upsert'} << 0
203 if exists $opts->{'upsert'};
204 $flags |= $opts->{'multiple'} << 1
205 if exists $opts->{'multiple'};
206 }
207 else {
208 $flags = !(!$opts);
209 }
210
211 my $conn = $self->_database->_client;
212 my $ns = $self->full_name;
213
214 my $update = MongoDB::write_update($ns, $query, $object, $flags);
215 if ($opts->{safe} or $conn->_w_want_safe ) {
216 return $self->_make_safe($update);
217 }
218
219 if ($conn->send($update) == -1) {
220 $conn->connect;
221 die("can't get db response, not connected");
222 }
223
224 return 1;
225}
226
227
228sub find_and_modify {
229 my ( $self, $opts ) = @_;
230
231 my $conn = $self->_database->_client;
232 my $db = $self->_database;
233
234 my $result = $db->run_command( [ findAndModify => $self->name, %$opts ] );
235
236 if ( not $result->{ok} ) {
237 return if ( $result->{errmsg} eq 'No matching object found' );
238 }
239
240 return $result->{value};
241}
242
243
244sub aggregate {
245 my ( $self, $pipeline ) = @_;
246
247 my $db = $self->_database;
248
249 my $result = $db->run_command( [ aggregate => $self->name, pipeline => $pipeline ] );
250
251 # TODO: handle errors?
252
253 return $result->{result};
254}
255
256
257sub rename {
258 my ($self, $collectionname) = @_;
259
260 my $conn = $self->_database->_client;
261 my $database = $conn->get_database( 'admin' );
262 my $fullname = $self->full_name;
263
264 my ($db, @collection_bits) = split(/\./, $fullname);
265 my $collection = join('.', @collection_bits);
266 my $obj = $database->run_command([ 'renameCollection' => "$db.$collection", 'to' => "$db.$collectionname" ]);
267
268 if(ref($obj) eq "HASH"){
269 return $conn->get_database( $db )->get_collection( $collectionname );
270 }
271 else {
272 die $obj;
273 }
274}
275
276
277sub remove {
278 my ($self, $query, $options) = @_;
279
280 my $conn = $self->_database->_client;
281
282 my ($just_one, $safe);
283 if (defined $options && ref $options eq 'HASH') {
284 $just_one = exists $options->{just_one} ? $options->{just_one} : 0;
285 $safe = $options->{safe} or $conn->_w_want_safe;
286 }
287 else {
288 $just_one = $options || 0;
289 }
290
291 my $ns = $self->full_name;
292 $query ||= {};
293
294 my $remove = MongoDB::write_remove($ns, $query, $just_one);
295 if ($safe) {
296 return $self->_make_safe($remove);
297 }
298
299 if ($conn->send($remove) == -1) {
300 $conn->connect;
301 die("can't get db response, not connected");
302 }
303
304 return 1;
305}
306
307
308sub ensure_index {
309 my ($self, $keys, $options, $garbage) = @_;
310 my $ns = $self->full_name;
311
312 # we need to use the crappy old api if...
313 # - $options isn't a hash, it's a string like "ascending"
314 # - $keys is a one-element array: [foo]
315 # - $keys is an array with more than one element and the second
316 # element isn't a direction (or at least a good one)
317 # - Tie::IxHash has values like "ascending"
318 if (($options && ref $options ne 'HASH') ||
319 (ref $keys eq 'ARRAY' &&
320 ($#$keys == 0 || $#$keys >= 1 && !($keys->[1] =~ /-?1/))) ||
321 (ref $keys eq 'Tie::IxHash' && $keys->[2][0] =~ /(de|a)scending/)) {
322 Carp::croak("you're using the old ensure_index format, please upgrade");
323 }
324
325 $keys = Tie::IxHash->new(@$keys) if ref $keys eq 'ARRAY';
326 my $obj = Tie::IxHash->new("ns" => $ns, "key" => $keys);
327
328 if (exists $options->{name}) {
329 $obj->Push("name" => $options->{name});
330 }
331 else {
332 $obj->Push("name" => MongoDB::Collection::to_index_string($keys));
333 }
334
335 foreach ("unique", "drop_dups", "background", "sparse") {
336 if (exists $options->{$_}) {
337 $obj->Push("$_" => ($options->{$_} ? boolean::true : boolean::false));
338 }
339 }
340 $options->{'no_ids'} = 1;
341
342 if (exists $options->{expire_after_seconds}) {
343 $obj->Push("expireAfterSeconds" => int($options->{expire_after_seconds}));
344 }
345
346 my ($db, $coll) = $ns =~ m/^([^\.]+)\.(.*)/;
347
348 my $indexes = $self->_database->get_collection("system.indexes");
349 return $indexes->insert($obj, $options);
350}
351
352
353sub _make_safe {
354 my ($self, $req) = @_;
355 my $conn = $self->_database->_client;
356 my $db = $self->_database->name;
357
358 my $last_error = Tie::IxHash->new(getlasterror => 1, w => $conn->w, wtimeout => $conn->wtimeout, j => $conn->j);
359 my ($query, $info) = MongoDB::write_query($db.'.$cmd', 0, 0, -1, $last_error);
360
361 $conn->send("$req$query");
362
363 my $cursor = MongoDB::Cursor->new(_ns => $info->{ns}, _client => $conn, _query => {});
364 $cursor->_init;
365 $cursor->_request_id($info->{'request_id'});
366
367 $conn->recv($cursor);
368 $cursor->started_iterating(1);
369
370 my $ok = $cursor->next();
371
372 # $ok->{ok} is 1 if err is set
373 Carp::croak $ok->{err} if $ok->{err};
374 # $ok->{ok} == 0 is still an error
375 if (!$ok->{ok}) {
376 Carp::croak $ok->{errmsg};
377 }
378
379 return $ok;
380}
381
382sub save {
383 my ($self, $doc, $options) = @_;
384
385 if (exists $doc->{"_id"}) {
386
387 if (!$options || !ref $options eq 'HASH') {
388 $options = {"upsert" => boolean::true};
389 }
390 else {
391 $options->{'upsert'} = boolean::true;
392 }
393
394 return $self->update({"_id" => $doc->{"_id"}}, $doc, $options);
395 }
396 else {
397 return $self->insert($doc, $options);
398 }
399}
400
401
402sub count {
403 my ($self, $query) = @_;
404 $query ||= {};
405
406 my $obj;
407 eval {
408 $obj = $self->_database->run_command([
409 count => $self->name,
410 query => $query,
411 ]);
412 };
413
414 # if there was an error, check if it was the "ns missing" one that means the
415 # collection hasn't been created or a real error.
416 if ($@) {
417 # if the request timed out, $obj might not be initialized
418 if ($obj && $obj =~ m/^ns missing/) {
419 return 0;
420 }
421 else {
422 die $@;
423 }
424 }
425
426 return $obj->{n};
427}
428
429
430sub validate {
431 my ($self, $scan_data) = @_;
432 $scan_data = 0 unless defined $scan_data;
433 my $obj = $self->_database->run_command({ validate => $self->name });
434}
435
436
437sub drop_indexes {
438 my ($self) = @_;
439 return $self->drop_index('*');
440}
441
442
443sub drop_index {
444 my ($self, $index_name) = @_;
445 return $self->_database->run_command([
446 deleteIndexes => $self->name,
447 index => $index_name,
448 ]);
449}
450
451
452sub get_indexes {
453 my ($self) = @_;
454 return $self->_database->get_collection('system.indexes')->query({
455 ns => $self->full_name,
456 })->all;
457}
458
459sub drop {
460 my ($self) = @_;
461 $self->_database->run_command({ drop => $self->name });
462 return;
463}
464
- -
46712µs23.38ms__PACKAGE__->meta->make_immutable;
# spent 3.36ms making 1 call to Class::MOP::Class::make_immutable # spent 13µs making 1 call to MongoDB::Collection::meta
468
46918µs1;
470
471__END__