File Coverage

blib/lib/MongoDB/Op/_Command.pm
Criterion Covered Total %
statement 27 59 45.7
branch 0 16 0.0
condition 0 5 0.0
subroutine 9 11 81.8
pod 0 1 0.0
total 36 92 39.1


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 60     60   338 use strict;
  60         113  
  60         1513  
16 60     60   257 use warnings;
  60         101  
  60         1803  
17             package MongoDB::Op::_Command;
18              
19             # Encapsulate running a command and returning a MongoDB::CommandResult
20              
21 60     60   295 use version;
  60         114  
  60         292  
22             our $VERSION = 'v2.2.2';
23              
24 60     60   4170 use Moo;
  60         179  
  60         304  
25              
26 60     60   16143 use MongoDB::_Constants;
  60         146  
  60         7108  
27 60         446 use MongoDB::_Types qw(
28             Document
29             ReadPreference
30             to_IxHash
31 60     60   404 );
  60         138  
32 60     60   71433 use List::Util qw/first/;
  60         120  
  60         6177  
33 60         397 use Types::Standard qw(
34             CodeRef
35             HashRef
36             Maybe
37             InstanceOf
38 60     60   439 );
  60         119  
39              
40 60     60   63447 use namespace::clean;
  60         120  
  60         339  
41              
42             has query => (
43             is => 'ro',
44             required => 1,
45             writer => '_set_query',
46             isa => Document,
47             );
48              
49             has query_flags => (
50             is => 'ro',
51             required => 1,
52             isa => HashRef,
53             );
54              
55             has read_preference => (
56             # Needs to be rw for transactions
57             is => 'rw',
58             isa => Maybe [ReadPreference],
59             );
60              
61             with $_ for qw(
62             MongoDB::Role::_PrivateConstructor
63             MongoDB::Role::_DatabaseOp
64             MongoDB::Role::_ReadPrefModifier
65             MongoDB::Role::_SessionSupport
66             MongoDB::Role::_CommandMonitoring
67             );
68              
69             my %IS_NOT_COMPRESSIBLE = map { ($_ => 1) } qw(
70             ismaster
71             saslstart
72             saslcontinue
73             getnonce
74             authenticate
75             createuser
76             updateuser
77             copydbsaslstart
78             copydbgetnonce
79             copydb
80             );
81              
82             sub execute {
83 0     0 0   my ( $self, $link, $topology_type ) = @_;
84 0   0       $topology_type ||= 'Single'; # if not specified, assume direct
85              
86 0           $self->_apply_session_and_cluster_time( $link, \$self->{query} );
87              
88 0           my ( $op_bson, $request_id );
89              
90 0 0         if ( $link->supports_op_msg ) {
91             # $query is passed as a reference because it *may* be replaced
92 0           $self->_apply_op_msg_read_prefs( $link, $topology_type, $self->{query_flags}, \$self->{query});
93 0           $self->{query} = to_IxHash( $self->{query} );
94 0           $self->{query}->Push( '$db', $self->db_name );
95             ( $op_bson, $request_id ) =
96 0           MongoDB::_Protocol::write_msg( $self->{bson_codec}, undef, $self->{query} );
97             } else {
98             # $query is passed as a reference because it *may* be replaced
99 0           $self->_apply_op_query_read_prefs( $link, $topology_type, $self->{query_flags}, \$self->{query});
100             ( $op_bson, $request_id ) =
101             MongoDB::_Protocol::write_query( $self->{db_name} . '.$cmd',
102 0           $self->{bson_codec}->encode_one( $self->{query} ), undef, 0, -1, $self->{query_flags});
103             }
104              
105 0 0         if ( length($op_bson) > MAX_BSON_WIRE_SIZE ) {
106             # XXX should this become public?
107 0           MongoDB::_CommandSizeError->throw(
108             message => "database command too large",
109             size => length $op_bson,
110             );
111             }
112              
113 0 0         $self->publish_command_started( $link, $self->{query}, $request_id )
114             if $self->monitoring_callback;
115              
116             my %write_opt = (
117 0           disable_compression => $IS_NOT_COMPRESSIBLE{ _get_command_name( $self->{query} ) },
118             );
119              
120 0           my $result;
121 0           eval {
122 0           $link->write( $op_bson, \%write_opt ),
123             ( $result = MongoDB::_Protocol::parse_reply( $link->read, $request_id ) );
124             };
125 0 0         if ( my $err = $@ ) {
126 0           $self->_update_session_connection_error( $err );
127 0 0         $self->publish_command_exception($err) if $self->monitoring_callback;
128 0           die $err;
129             }
130              
131             $self->publish_command_reply( $result->{docs} )
132 0 0         if $self->monitoring_callback;
133              
134             my $res = MongoDB::CommandResult->_new(
135 0           output => $self->{bson_codec}->decode_one( $result->{docs} ),
136             address => $link->address,
137             session => $self->session,
138             );
139              
140 0           $self->_update_session_pre_assert( $res );
141              
142 0           $res->assert;
143              
144 0           $self->_update_session_and_cluster_time($res);
145              
146 0           $self->_assert_session_errors($res);
147              
148 0           return $res;
149             }
150              
151             sub _get_command_name {
152 0     0     my ($doc) = @_;
153 0           my $type = ref $doc;
154             return
155             $type eq 'ARRAY' || $type eq 'BSON::Doc' ? $doc->[0]
156             : $type eq 'Tie::IxHash' ? $doc->Keys(0)
157 0 0 0       : $doc->{ [ keys %$doc ]->[0] };
    0          
158             }
159              
160             1;