File Coverage

blib/lib/MongoDB/Op/_Query.pm
Criterion Covered Total %
statement 57 134 42.5
branch 0 158 0.0
condition 0 40 0.0
subroutine 19 33 57.5
pod 0 5 0.0
total 76 370 20.5


line stmt bran cond sub pod time code
1             # Copyright 2014 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 59     59   394 use strict;
  59         134  
  59         1647  
16 59     59   306 use warnings;
  59         152  
  59         5003  
17              
18             package MongoDB::Op::_Query;
19              
20             # Encapsulate a query operation; returns a MongoDB::QueryResult object
21              
22 59     59   397 use version;
  59         128  
  59         332  
23             our $VERSION = 'v2.2.1';
24              
25 59     59   4824 use boolean;
  59         132  
  59         429  
26 59     59   4178 use Moo;
  59         169  
  59         455  
27              
28 59     59   19923 use Scalar::Util qw/blessed/;
  59         153  
  59         3560  
29 59     59   400 use List::Util qw/min/;
  59         133  
  59         3889  
30 59     59   411 use MongoDB::QueryResult;
  59         151  
  59         1610  
31 59     59   24631 use MongoDB::QueryResult::Filtered;
  59         172  
  59         1937  
32 59     59   437 use MongoDB::_Constants;
  59         120  
  59         6892  
33 59     59   408 use MongoDB::_Protocol;
  59         133  
  59         1695  
34 59         423 use MongoDB::_Types qw(
35             Document
36             CursorType
37             IxHash
38             to_IxHash
39 59     59   321 );
  59         144  
40 59         268 use Types::Standard qw(
41             CodeRef
42             HashRef
43             InstanceOf
44             Maybe
45             Num
46             Str
47 59     59   84930 );
  59         151  
48              
49 59     59   74424 use namespace::clean;
  59         143  
  59         277  
50              
51             has client => (
52             is => 'ro',
53             required => 1,
54             isa => InstanceOf ['MongoDB::MongoClient'],
55             );
56              
57             #--------------------------------------------------------------------------#
58             # Attributes based on the CRUD API spec: filter and options
59             #--------------------------------------------------------------------------#
60              
61             has filter => (
62             is => 'ro',
63             isa => Document,
64             required => 1,
65             );
66              
67             # XXX The provided 'options' field *MUST* be the output of the class method
68             # 'precondition_options'. Normally, we'd do this in a BUILD method, but in
69             # order to allow the use of the private constructor for speed, we push
70             # responsibility for conditioning the options to the calling site.
71              
72             has options => (
73             is => 'ro',
74             isa => HashRef,
75             required => 1,
76             );
77              
78             # Not a MongoDB query attribute; this is used during construction of a
79             # result object
80             has post_filter => (
81             is => 'ro',
82             predicate => 'has_post_filter',
83             isa => Maybe [CodeRef],
84             );
85              
86             with $_ for qw(
87             MongoDB::Role::_PrivateConstructor
88             MongoDB::Role::_CollectionOp
89             MongoDB::Role::_ReadOp
90             MongoDB::Role::_CommandCursorOp
91             MongoDB::Role::_OpReplyParser
92             MongoDB::Role::_ReadPrefModifier
93             );
94              
95             sub execute {
96 0     0 0   my ( $self, $link, $topology ) = @_;
97              
98 0 0 0       if ( defined $self->{options}{collation} and !$link->supports_collation ) {
99 0           MongoDB::UsageError->throw(
100             "MongoDB host '" . $link->address . "' doesn't support collation" );
101             }
102              
103 0 0         my $res =
104             $link->supports_query_commands
105             ? $self->_command_query( $link, $topology )
106             : $self->_legacy_query( $link, $topology );
107              
108 0           return $res;
109             }
110              
111             sub _command_query {
112 0     0     my ( $self, $link, $topology ) = @_;
113              
114 0           my $op = MongoDB::Op::_Command->_new(
115             db_name => $self->db_name,
116             query => $self->_as_command,
117             query_flags => {},
118             read_preference => $self->read_preference,
119             bson_codec => $self->bson_codec,
120             session => $self->session,
121             monitoring_callback => $self->monitoring_callback,
122             );
123 0           my $res = $op->execute( $link, $topology );
124              
125 0           return $self->_build_result_from_cursor($res);
126             }
127              
128             sub _legacy_query {
129 0     0     my ( $self, $link, $topology ) = @_;
130              
131 0           my $opts = $self->{options};
132              
133             my $query_flags = {
134             tailable => ( $opts->{cursorType} =~ /^tailable/ ? 1 : 0 ),
135             await_data => $opts->{cursorType} eq 'tailable_await',
136             immortal => $opts->{noCursorTimeout},
137             partial => $opts->{allowPartialResults},
138 0 0         };
139              
140 0           my $query = $self->_as_query_document($opts);
141              
142 0           my $full_name = $self->full_name;
143              
144             # rules for calculating initial batch size
145 0   0       my $limit = $opts->{limit} // 0;
146 0   0       my $batch_size = $opts->{batchSize} // 0;
147 0 0         my $n_to_return =
    0          
    0          
148             $limit == 0 ? $batch_size
149             : $batch_size == 0 ? $limit
150             : $limit < 0 ? $limit
151             : min( $limit, $batch_size );
152              
153             my $proj =
154 0 0         $opts->{projection} ? $self->bson_codec->encode_one( $opts->{projection} ) : undef;
155              
156             # $query is passed as a reference because it *may* be replaced
157 0           $self->_apply_op_query_read_prefs( $link, $topology, $query_flags, \$query );
158              
159 0           my $filter = $self->bson_codec->encode_one($query);
160              
161             my ( $op_bson, $request_id ) =
162             MongoDB::_Protocol::write_query( $full_name, $filter, $proj, $opts->{skip},
163 0           $n_to_return, $query_flags );
164              
165 0           my $result =
166             $self->_query_and_receive( $link, $op_bson, $request_id, $self->bson_codec );
167              
168 0 0         my $class =
169             $self->has_post_filter ? "MongoDB::QueryResult::Filtered" : "MongoDB::QueryResult";
170              
171             return $class->_new(
172             _client => $self->client,
173             _address => $link->address,
174             _full_name => $full_name,
175             _bson_codec => $self->bson_codec,
176             _batch_size => $n_to_return,
177             _cursor_at => 0,
178             _limit => $limit,
179             _cursor_id => $result->{cursor_id},
180             _cursor_start => $result->{starting_from},
181             _cursor_flags => $result->{flags} || {},
182             _cursor_num => $result->{number_returned},
183             _docs => $result->{docs},
184 0   0       _post_filter => $self->post_filter,
185             );
186             }
187              
188             # awful hack: avoid calling into boolean to get true/false
189             my $TRUE = boolean::true();
190             my $FALSE = boolean::false();
191              
192             sub _as_query_document {
193 0     0     my ($self, $opts) = @_;
194              
195             # Reconstruct query modifiers style from options. However, we only
196             # apply $maxTimeMS if we're not running a command via OP_QUERY against
197             # the '$cmd' collection. For commands, we expect maxTimeMS to be in
198             # the command itself.
199             my $query = {
200             ( defined $opts->{comment} ? ( '$comment' => $opts->{comment} ) : () ),
201             ( defined $opts->{hint} ? ( '$hint' => $opts->{hint} ) : () ),
202             ( defined $opts->{max} ? ( '$max' => $opts->{max} ) : () ),
203             ( defined $opts->{min} ? ( '$min' => $opts->{min} ) : () ),
204             ( defined $opts->{sort} ? ( '$orderby' => $opts->{sort} ) : () ),
205             ( defined $opts->{maxScan} ? ( '$maxScan' => $opts->{maxScan} ) : () ),
206             ( defined $opts->{returnKey} ? ( '$returnKey' => $opts->{returnKey} ) : () ),
207             ( defined $opts->{showRecordId} ? ( '$showDiskLoc' => $opts->{showRecordId} ) : () ),
208             ( defined $opts->{snapshot} ? ( '$snapshot' => $opts->{snapshot} ) : () ),
209             (
210             ( defined $opts->{maxTimeMS} && $self->coll_name !~ /\A\$cmd/ )
211             ? ( '$maxTimeMS' => $opts->{maxTimeMS} )
212             : ()
213             ),
214             # Not a user-provided option: this is only set by MongoDB::Op::_Explain
215             # for legacy $explain support
216 0 0 0       ( defined $opts->{explain} ? ( '$explain' => $TRUE ) : () ),
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
217             ( '$query' => ( $self->filter || {} ) ),
218             };
219              
220             # if no modifers were added and there is no 'query' key in '$query'
221             # we remove the extra layer; this is necessary as some special
222             # command queries will choke on '$query'
223             # (see https://jira.mongodb.org/browse/SERVER-14294)
224             $query = $query->{'$query'}
225             if keys %$query == 1 && !(
226             ( ref( $query->{'$query'} ) eq 'Tie::IxHash' )
227             ? $query->{'$query'}->EXISTS('query')
228             : exists $query->{'$query'}{query}
229 0 0 0       );
    0          
230              
231 0           return $query;
232             }
233              
234             my %options_to_prune =
235             map { $_ => 1 } qw/limit batchSize cursorType maxAwaitTimeMS modifiers/;
236              
237             sub _as_command {
238 0     0     my ($self) = @_;
239              
240 0           my $opts = $self->{options};
241              
242 0   0       my $limit = $opts->{limit} // 0;
243 0   0       my $batch_size = $opts->{batchSize} // 0;
244 0   0       my $single_batch = $limit < 0 || $batch_size < 0;
245              
246             # find command always takes positive limit and batch size, so normalize
247             # them based on rules in the "find, getmore, kill cursor" spec:
248             # https://github.com/mongodb/specifications/blob/master/source/find_getmore_killcursors_commands.rst
249 0           $limit = abs($limit);
250 0 0         $batch_size = $limit if $single_batch;
251              
252 0 0         my $tailable = $opts->{cursorType} =~ /^tailable/ ? $TRUE : $FALSE;
253 0 0         my $await_data = $opts->{cursorType} eq 'tailable_await' ? $TRUE : $FALSE;
254              
255             return [
256             # Always send these options
257             find => $self->{coll_name},
258             filter => $self->{filter},
259             tailable => $tailable,
260             awaitData => $await_data,
261             singleBatch => ( $single_batch ? $TRUE : $FALSE ),
262 0           @{ $self->{read_concern}->as_args( $self->session ) },
263              
264             ( $limit ? ( limit => $limit ) : () ),
265             ( $batch_size ? ( batchSize => $batch_size ) : () ),
266              
267             # Merge in any server options, but cursorType and maxAwaitTimeMS aren't
268             # actually a server option, so we remove it during the merge. Also
269             # remove limit and batchSize as those may have been modified
270              
271 0 0         ( map { $_ => $opts->{$_} } grep { !exists $options_to_prune{$_} } keys %$opts )
  0 0          
  0 0          
272             ];
273             }
274              
275             # precondition_options is a class method that, given query options,
276             # combines keys from the deprecated 'modifiers' option with the correct
277             # precedence. It provides defaults and and coerces values if needed.
278             #
279             # It returns a hash reference with extracted and coerced options.
280             sub precondition_options {
281 0     0 0   my ( $class, $opts ) = @_;
282 0   0       $opts //= {};
283 0   0       my $mods = $opts->{modifiers} // {};
284             my %merged = (
285              
286             #
287             # Keys always included in commands or used in calcuations need a
288             # default value if not provided.
289             #
290              
291             # integer
292             ( skip => $opts->{skip} // 0 ),
293              
294             # boolean
295             ( allowPartialResults => ( $opts->{allowPartialResults} ? $TRUE : $FALSE ) ),
296              
297             # boolean
298             ( noCursorTimeout => ( $opts->{noCursorTimeout} ? $TRUE : $FALSE ) ),
299              
300             # integer
301             ( batchSize => $opts->{batchSize} // 0 ),
302              
303             # integer
304             ( limit => $opts->{limit} // 0 ),
305              
306             # string
307             ( cursorType => $opts->{cursorType} // 'non_tailable' ),
308              
309             #
310             # These are optional keys that should be included only if defined.
311             #
312              
313             # integer
314             (
315             defined $opts->{maxAwaitTimeMS} ? ( maxAwaitTimeMS => $opts->{maxAwaitTimeMS} ) : ()
316             ),
317              
318             # hashref
319             ( defined $opts->{projection} ? ( projection => $opts->{projection} ) : () ),
320              
321             # hashref
322             ( defined $opts->{collation} ? ( collation => $opts->{collation} ) : () ),
323              
324             #
325             # These keys have equivalents in the 'modifiers' option: if an options
326             # key exists it takes precedence over a modifiers key, but undefined
327             # values disable the option in both cases.
328             #
329              
330             # string
331             (
332             ( exists $opts->{comment} )
333             ? ( ( defined $opts->{comment} ) ? ( comment => $opts->{comment} ) : () )
334             : (
335             ( defined $mods->{'$comment'} )
336             ? ( comment => $mods->{'$comment'} )
337             : ()
338             )
339             ),
340              
341             # string or ordered document
342             (
343             ( exists $opts->{hint} )
344             ? ( ( defined $opts->{hint} ) ? ( hint => $opts->{hint} ) : () )
345             : (
346             ( defined $mods->{'$hint'} )
347             ? ( hint => $mods->{'$hint'} )
348             : ()
349             )
350             ),
351              
352             # ordered document
353             (
354             ( exists $opts->{max} )
355             ? ( ( defined $opts->{max} ) ? ( max => $opts->{max} ) : () )
356             : (
357             ( defined $mods->{'$max'} )
358             ? ( max => $mods->{'$max'} )
359             : ()
360             )
361             ),
362              
363             # ordered document
364             (
365             ( exists $opts->{min} )
366             ? ( ( defined $opts->{min} ) ? ( min => $opts->{min} ) : () )
367             : (
368             ( defined $mods->{'$min'} )
369             ? ( min => $mods->{'$min'} )
370             : ()
371             )
372             ),
373              
374             # integer
375             (
376             ( exists $opts->{maxScan} )
377             ? ( ( defined $opts->{maxScan} ) ? ( maxScan => $opts->{maxScan} ) : () )
378             : (
379             ( defined $mods->{'$maxScan'} )
380             ? ( maxScan => $mods->{'$maxScan'} )
381             : ()
382             )
383             ),
384              
385             # integer
386             (
387             ( exists $opts->{maxTimeMS} )
388             ? ( ( defined $opts->{maxTimeMS} ) ? ( maxTimeMS => $opts->{maxTimeMS} ) : () )
389             : (
390             ( defined $mods->{'$maxTimeMS'} )
391             ? ( maxTimeMS => $mods->{'$maxTimeMS'} )
392             : ()
393             )
394             ),
395              
396             # ordered document
397              
398             (
399             ( exists $opts->{sort} )
400             ? ( ( defined $opts->{sort} ) ? ( sort => $opts->{sort} ) : () )
401             : (
402             ( defined $mods->{'$orderby'} )
403             ? ( sort => $mods->{'$orderby'} )
404             : ()
405             )
406             ),
407              
408             # boolean
409             (
410             ( exists $opts->{returnKey} )
411             ? ( ( defined $opts->{returnKey} ) ? ( returnKey => $opts->{returnKey} ) : () )
412             : (
413             ( defined $mods->{'$returnKey'} )
414             ? ( returnKey => $mods->{'$returnKey'} )
415             : ()
416             )
417             ),
418              
419             # boolean
420             (
421             ( exists $opts->{showRecordId} )
422             ? (
423             ( defined $opts->{showRecordId} ) ? ( showRecordId => $opts->{showRecordId} ) : () )
424             : (
425             ( defined $mods->{'$showDiskLoc'} )
426             ? ( showRecordId => $mods->{'$showDiskLoc'} )
427             : ()
428             )
429             ),
430              
431             # boolean
432             (
433             ( exists $opts->{snapshot} )
434             ? ( ( defined $opts->{snapshot} ) ? ( snapshot => $opts->{snapshot} ) : () )
435             : (
436             ( defined $mods->{'$snapshot'} )
437 0 0 0       ? ( snapshot => $mods->{'$snapshot'} )
    0 0        
    0 0        
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
438             : ()
439             )
440             ),
441             );
442              
443             # coercions to IxHash: unrolled for efficiency
444 0 0         $merged{sort} = to_IxHash( $merged{sort} ) if exists $merged{sort};
445 0 0         $merged{max} = to_IxHash( $merged{max} ) if exists $merged{max};
446 0 0         $merged{min} = to_IxHash( $merged{min} ) if exists $merged{min};
447              
448             # optional coercion to IxHash if hint is a reference type
449 0 0         $merged{hint} = to_IxHash( $merged{hint} ) if ref $merged{hint};
450              
451             # coercions to boolean (if not already coerced): unrolled for efficiency
452             $merged{returnKey} = ( $merged{returnKey} ? $TRUE : $FALSE )
453 0 0         if exists $merged{returnKey};
    0          
454             $merged{showRecordId} = ( $merged{showRecordId} ? $TRUE : $FALSE )
455 0 0         if exists $merged{showRecordId};
    0          
456             $merged{snapshot} = ( $merged{snapshot} ? $TRUE : $FALSE )
457 0 0         if exists $merged{snapshot};
    0          
458              
459 0           return \%merged;
460             }
461              
462             # Setters are provided to support the MongoDB::Cursor interface that modifies
463             # options prior to execution. These methods preserve the rules for each key
464             # that are used in precondition_options. Specifically, if passed *undef*,
465             # the options are cleared, except for options that must have a default.
466              
467             # setters for boolean options
468             for my $key ( qw/returnKey showRecordId snapshot/ ) {
469 59     59   138140 no strict 'refs';
  59         184  
  59         8618  
470             my $method = "set_$key";
471             *{$method} = sub {
472 0     0     my ($self,$value) = @_;
473 0 0         if ( defined $value ) {
474 0 0         $self->{options}{$key} = $value ? $TRUE : $FALSE;
475             }
476             else {
477 0           delete $self->{options}{$key};
478             }
479             }
480             }
481              
482             # setters for scalar & hashref options
483             for my $key ( qw/collation comment maxAwaitTimeMS maxScan maxTimeMS projection/ ) {
484 59     59   452 no strict 'refs';
  59         152  
  59         9158  
485             my $method = "set_$key";
486             *{$method} = sub {
487 0     0     my ($self,$value) = @_;
488 0 0         if ( defined $value ) {
489 0           $self->{options}{$key} = $value;
490             }
491             else {
492 0           delete $self->{options}{$key};
493             }
494             }
495             }
496              
497             # setters for ordered document options
498             for my $key ( qw/max min sort/ ) {
499 59     59   456 no strict 'refs';
  59         139  
  59         12589  
500             my $method = "set_$key";
501             *{$method} = sub {
502 0     0     my ($self,$value) = @_;
503 0 0         if ( defined $value ) {
504 0           $self->{options}{$key} = to_IxHash($value);
505             }
506             else {
507 0           delete $self->{options}{$key};
508             }
509             }
510             }
511              
512             # setter for hint, which is an ordered document *or* scalar
513             sub set_hint {
514 0     0 0   my ($self,$value) = @_;
515 0 0         if ( defined $value ) {
516 0 0         $self->{options}{hint} = ref $value ? to_IxHash($value) : $value;
517             }
518             else {
519 0           delete $self->{options}{hint};
520             }
521             }
522              
523             # setters with default of 0
524             for my $key ( qw/batchSize limit skip/ ) {
525 59     59   446 no strict 'refs';
  59         131  
  59         6448  
526             my $method = "set_$key";
527             *{$method} = sub {
528 0     0     my ($self,$value) = @_;
529 0   0       $self->{options}{$key} = $value // 0;
530             }
531             }
532              
533             # setters with default of $FALSE
534             for my $key ( qw/allowPartialResults noCursorTimeout/ ) {
535 59     59   447 no strict 'refs';
  59         129  
  59         11347  
536             my $method = "set_$key";
537             *{$method} = sub {
538 0     0     my ($self,$value) = @_;
539 0 0         $self->{options}{$key} = $value ? $TRUE : $FALSE;
540             }
541             }
542              
543             # cursorType has a specific default value
544             sub set_cursorType {
545 0     0 0   my ($self,$value) = @_;
546 0   0       $self->{options}{cursorType} = $value // 'non_tailable';
547             }
548              
549             sub has_hint {
550 0     0 0   my ($self) = @_;
551 0           return $self->{options}{hint};
552             }
553              
554             1;