PERL-413 wire up max_time_ms configuration option

This commit adds 'max_time_ms' to Database, Collection and GridFS
classes and uses it as the default for any queries that support it
(but only on server 2.6+).

This is important because we'd rather get a database error than a socket
timeout, as the latter invalidates the connection and will trigger
topology scanning.

The max_time_ms.t tests have been expanded, but now only run with
a modern Test::Harness to ensure that they don't get run in parallel
with other tests and cause those tests to fail when failpoints are
turned on.

Queries take care to strip maxTimeMS for '$cmd*' collections, where
it is illegal.

dist.ini

@@ -134,6 +134,9 @@ Net::SSLeay = 1.49
 [Prereqs / Suggests]
 IO::Socket::SSL = 1.56
 
+[Prereqs / TestRecommends]
+Test::Harness = 3.31
+
 ; *** MetaProvider phase
 
 ; Set homepage and repository metadata fields from the 'origin' remote,

lib/MongoDB/Collection.pm

@@ -109,6 +109,22 @@ has write_concern => (
     coerce   => 1,
 );
 
+=attr max_time_ms
+
+Specifies the default maximum amount of time in milliseconds that the
+server should use for working on a query.
+
+B<Note>: this will only be used for server versions 2.6 or greater, as that
+was when the C<$maxTimeMS> meta-operator was introduced.
+
+=cut
+
+has max_time_ms => (
+    is      => 'ro',
+    isa     => NonNegNum,
+    required => 1,
+);
+
 =attr bson_codec
 
 An object that provides the C<encode_one> and C<decode_one> methods, such
@@ -577,6 +593,11 @@ sub find {
     # backwards compatible sort option for deprecated 'query' alias
     $options->{sort} = delete $options->{sort_by} if $options->{sort_by};
 
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
+
     # coerce to IxHash
     __ixhash($options, 'sort');
 
@@ -636,6 +657,12 @@ sub find_one {
         Optional [MaybeHashRef],
     );
     my ( $self, $filter, $projection, $options ) = $find_one_args->(@_);
+    $options ||= {};
+
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
 
     # coerce to IxHash
     __ixhash($options, 'sort');
@@ -686,6 +713,11 @@ sub find_one_and_delete {
     # rename projection -> fields
     $options->{fields} = delete $options->{projection} if exists $options->{projection};
 
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
+
     # coerce to IxHash
     __ixhash($options, 'sort');
 
@@ -825,6 +857,11 @@ sub aggregate {
         $options->{$k} = ( $options->{$k} ? true : false ) if exists $options->{$k};
     }
 
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
+
     # read preferences are ignored if the last stage is $out
     my ($last_op) = keys %{ $pipeline->[-1] };
     my $read_pref = $last_op eq '$out' ? undef : $self->read_preference;
@@ -876,6 +913,11 @@ sub count {
     $filter  ||= {};
     $options ||= {};
 
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
+
     # string is OK so we check ref, not just exists
     __ixhash($options, 'hint') if ref $options->{hint};
 
@@ -918,6 +960,11 @@ sub distinct {
     $filter ||= {};
     $options ||= {};
 
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
+
     my $op = MongoDB::Op::_Distinct->new(
         db_name         => $self->database->name,
         coll_name       => $self->name,
@@ -1298,6 +1345,11 @@ sub _find_one_and_update_or_replace {
     # rename projection -> fields
     $options->{fields} = delete $options->{projection} if exists $options->{projection};
 
+    # possibly fallback to default maxTimeMS
+    if ( ! exists $options->{maxTimeMS} && $self->max_time_ms ) {
+        $options->{maxTimeMS} = $self->max_time_ms;
+    }
+
     # coerce to IxHash
     __ixhash($options, 'sort');
 

lib/MongoDB/Database.pm

@@ -84,6 +84,22 @@ has write_concern => (
     coerce   => 1,
 );
 
+=attr max_time_ms
+
+Specifies the maximum amount of time in milliseconds that the server should use
+for working on a query.
+
+B<Note>: this will only be used for server versions 2.6 or greater, as that
+was when the C<$maxTimeMS> meta-operator was introduced.
+
+=cut
+
+has max_time_ms => (
+    is      => 'ro',
+    isa     => NonNegNum,
+    required => 1,
+);
+
 =attr bson_codec
 
 An object that provides the C<encode_one> and C<decode_one> methods, such as
@@ -148,6 +164,7 @@ sub get_collection {
         read_preference => $self->read_preference,
         write_concern   => $self->write_concern,
         bson_codec      => $self->bson_codec,
+        max_time_ms     => $self->max_time_ms,
         ( $options ? %$options : () ),
         # not allowed to be overridden by options
         database => $self,
@@ -181,6 +198,7 @@ sub get_gridfs {
     return MongoDB::GridFS->new(
         read_preference => $self->read_preference,
         write_concern   => $self->write_concern,
+        max_time_ms     => $self->max_time_ms,
         ( $options ? %$options : () ),
         # not allowed to be overridden by options
         _database => $self,

lib/MongoDB/GridFS.pm

@@ -77,6 +77,22 @@ has write_concern => (
     coerce   => 1,
 );
 
+=attr max_time_ms
+
+Specifies the default maximum amount of time in milliseconds that the
+server should use for working on a query.
+
+B<Note>: this will only be used for server versions 2.6 or greater, as that
+was when the C<$maxTimeMS> meta-operator was introduced.
+
+=cut
+
+has max_time_ms => (
+    is      => 'ro',
+    isa     => NonNegNum,
+    required => 1,
+);
+
 =attr prefix
 
 The prefix used for the collections.  Defaults to "fs".
@@ -101,7 +117,8 @@ sub _build_files {
         $self->prefix . '.files',
         {
             read_preference => $self->read_preference,
-            write_concern   => $self->write_concern
+            write_concern   => $self->write_concern,
+            max_time_ms     => $self->max_time_ms,
         }
     );
     return $coll;
@@ -119,7 +136,8 @@ sub _build_chunks {
         $self->prefix . '.chunks',
         {
             read_preference => $self->read_preference,
-            write_concern   => $self->write_concern
+            write_concern   => $self->write_concern,
+            max_time_ms     => $self->max_time_ms,
         }
     );
     return $coll;

lib/MongoDB/MongoClient.pm

@@ -401,7 +401,7 @@ This may be set in a connection string with the C<maxTimeMS> option.
 
 has max_time_ms => (
     is      => 'ro',
-    isa     => Num,
+    isa     => NonNegNum,
     lazy    => 1,
     builder => '_build_max_time_ms',
 );
@@ -1310,6 +1310,7 @@ sub get_database {
         read_preference => $self->read_preference,
         write_concern   => $self->write_concern,
         bson_codec      => $self->bson_codec,
+        max_time_ms     => $self->max_time_ms,
         ( $options ? %$options : () ),
         # not allowed to be overridden by options
         _client       => $self,

lib/MongoDB/_Query.pm

@@ -160,11 +160,18 @@ sub as_query_op {
         $query->STORE( $k, $v );
     }
 
-    # if these exists, they overwrite any earlier modifers
-    for my $k (qw/maxTimeMS comment/) {
-        next unless my $v = $self->$k;
-        $query->STORE( "\$$k", $v );
+    # if comment exists, it overwrites any earlier modifers
+    if ( my $v = $self->comment ) {
+        $query->STORE( '$comment' => $v );
     }
+
+    # if maxTimeMS exists, it overwrites any earlier modifers
+    if ( my $v = $self->maxTimeMS ) {
+        # omit for $cmd* queries
+        $query->STORE( '$maxTimeMS' => $v )
+          unless $self->coll_name =~ /\A\$cmd/;
+    }
+
     $query->STORE( '$orderby', $self->sort ) if $self->sort->Keys;
 
     # if no modifers were added and there is no 'query' key in '$query'

t/lib/MongoDBTest.pm

@@ -95,7 +95,7 @@ BEGIN {
 sub server_version {
 
     my $conn = shift;
-    my $build = $conn->get_database( 'admin' )->get_collection( '$cmd' )->find_one( { buildInfo => 1 } );
+    my $build = $conn->send_admin_command( [ buildInfo => 1 ] )->output;
     my ($version_str) = $build->{version} =~ m{^([0-9.]+)};
     return version->parse("v$version_str");
 }