File Coverage

blib/lib/MongoDB/MongoClient.pm
Criterion Covered Total %
statement 220 336 65.4
branch 58 132 43.9
condition 12 40 30.0
subroutine 72 95 75.7
pod 12 15 80.0
total 374 618 60.5


line stmt bran cond sub pod time code
1             # Copyright 2012 - 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   349 use strict;
  59         98  
  59         1549  
16 59     59   258 use warnings;
  59         91  
  59         1840  
17             package MongoDB::MongoClient;
18              
19             # ABSTRACT: A connection to a MongoDB server or multi-server deployment
20              
21 59     59   276 use version;
  59         111  
  59         260  
22             our $VERSION = 'v2.2.2';
23              
24 59     59   27706 use Moo;
  59         515748  
  59         284  
25 59     59   94837 use MongoDB::ClientSession;
  59         190  
  59         2111  
26 59     59   40212 use MongoDB::Cursor;
  59         223  
  59         1980  
27 59     59   391 use MongoDB::Error;
  59         121  
  59         5925  
28 59     59   346 use MongoDB::Op::_Command;
  59         119  
  59         1131  
29 59     59   24158 use MongoDB::Op::_FSyncUnlock;
  59         204  
  59         1993  
30 59     59   388 use MongoDB::ReadConcern;
  59         116  
  59         984  
31 59     59   347 use MongoDB::ReadPreference;
  59         120  
  59         947  
32 59     59   249 use MongoDB::WriteConcern;
  59         103  
  59         968  
33 59     59   289 use MongoDB::_Constants;
  59         105  
  59         6130  
34 59     59   26375 use MongoDB::_Credential;
  59         179  
  59         2561  
35 59     59   30526 use MongoDB::_Dispatcher;
  59         179  
  59         1960  
36 59     59   24078 use MongoDB::_SessionPool;
  59         219  
  59         1947  
37 59     59   39501 use MongoDB::_Topology;
  59         241  
  59         2462  
38 59     59   25432 use MongoDB::_URI;
  59         234  
  59         2296  
39 59     59   462 use BSON 1.012000;
  59         1540  
  59         2700  
40 59     59   348 use Digest::MD5;
  59         129  
  59         1623  
41 59     59   297 use UUID::URandom;
  59         125  
  59         1535  
42 59     59   292 use Tie::IxHash;
  59         121  
  59         2386  
43 59     59   287 use Time::HiRes qw/usleep/;
  59         114  
  59         406  
44 59     59   7246 use Carp 'carp', 'croak', 'confess';
  59         123  
  59         3406  
45 59     59   366 use Safe::Isa 1.000007;
  59         1080  
  59         5790  
46 59     59   390 use Scalar::Util qw/reftype weaken/;
  59         125  
  59         2698  
47 59     59   342 use boolean;
  59         112  
  59         570  
48 59     59   3779 use Encode;
  59         131  
  59         5330  
49 59         524 use MongoDB::_Types qw(
50             ArrayOfHashRef
51             AuthMechanism
52             Boolish
53             BSONCodec
54             CompressionType
55             Document
56             HeartbeatFreq
57             MaxStalenessNum
58             NonNegNum
59             ReadPrefMode
60             ReadPreference
61             ZlibCompressionLevel
62 59     59   411 );
  59         121  
63 59         300 use Types::Standard qw(
64             CodeRef
65             HashRef
66             ArrayRef
67             InstanceOf
68             Undef
69             Int
70             Num
71             Str
72             Maybe
73 59     59   129745 );
  59         135  
74              
75 59     59   97558 use namespace::clean -except => 'meta';
  59         138  
  59         417  
76              
77             #--------------------------------------------------------------------------#
78             # public attributes
79             #
80             # Of these, only host, port and bson_codec are set without regard for
81             # connection string options. The rest are built lazily in BUILD so that
82             # option precedence can be resolved.
83             #--------------------------------------------------------------------------#
84              
85             #pod =attr host
86             #pod
87             #pod The C attribute specifies either a single server to connect to (as
88             #pod C or C), or else a L
89             #pod STRING URI> with a seed list of one or more servers plus connection options.
90             #pod
91             #pod B: Options specified in the connection string take precedence over options
92             #pod provided as constructor arguments.
93             #pod
94             #pod Defaults to the connection string URI C.
95             #pod
96             #pod For IPv6 support, you must have a recent version of L
97             #pod installed. This module ships with the Perl core since v5.20.0 and is
98             #pod available on CPAN for older Perls.
99             #pod
100             #pod =cut
101              
102             has host => (
103             is => 'ro',
104             isa => Str,
105             default => 'mongodb://localhost:27017',
106             );
107              
108             #pod =attr app_name
109             #pod
110             #pod This attribute specifies an application name that should be associated with
111             #pod this client. The application name will be communicated to the server as
112             #pod part of the initial connection handshake, and will appear in
113             #pod connection-level and operation-level diagnostics on the server generated on
114             #pod behalf of this client. This may be set in a connection string with the
115             #pod C option.
116             #pod
117             #pod The default is the empty string, which indicates a lack of an application
118             #pod name.
119             #pod
120             #pod The application name must not exceed 128 bytes.
121             #pod
122             #pod =cut
123              
124             has app_name => (
125             is => 'lazy',
126             isa => Str,
127             builder => '_build_app_name',
128             );
129              
130             sub _build_app_name {
131 189     189   2170 my ($self) = @_;
132 189         707 my $app_name = $self->__uri_or_else(
133             u => 'appname',
134             e => 'app_name',
135             d => '',
136             );
137 189 100       632 unless ( length($app_name) <= 128 ) {
138 1         23 MongoDB::UsageError->throw("app name must be at most 128 bytes");
139             }
140 188         3001 return $app_name;
141             }
142              
143             #pod =attr auth_mechanism
144             #pod
145             #pod This attribute determines how the client authenticates with the server.
146             #pod Valid values are:
147             #pod
148             #pod =for :list
149             #pod * NONE
150             #pod * DEFAULT
151             #pod * MONGODB-CR
152             #pod * MONGODB-X509
153             #pod * GSSAPI
154             #pod * PLAIN
155             #pod * SCRAM-SHA-1
156             #pod
157             #pod If not specified, then if no username or C URI option is provided,
158             #pod it defaults to NONE. Otherwise, it is set to DEFAULT, which chooses
159             #pod SCRAM-SHA-1 if available or MONGODB-CR otherwise.
160             #pod
161             #pod This may be set in a connection string with the C option.
162             #pod
163             #pod =cut
164              
165             has auth_mechanism => (
166             is => 'lazy',
167             isa => AuthMechanism,
168             builder => '_build_auth_mechanism',
169             );
170              
171             sub _build_auth_mechanism {
172 188     188   8717 my ($self) = @_;
173              
174 188   100     2677 my $source = $self->_uri->options->{authsource} // "";
175 188 100 100     4587 my $default = length( $self->username ) || length($source) ? 'DEFAULT' : 'NONE';
176              
177 188         9505 return $self->__uri_or_else(
178             u => 'authmechanism',
179             e => 'auth_mechanism',
180             d => $default,
181             );
182             }
183              
184             #pod =attr auth_mechanism_properties
185             #pod
186             #pod This is an optional hash reference of authentication mechanism specific properties.
187             #pod See L for details.
188             #pod
189             #pod This may be set in a connection string with the C
190             #pod option. If given, the value must be key/value pairs joined with a ":".
191             #pod Multiple pairs must be separated by a comma. If ": or "," appear in a key or
192             #pod value, they must be URL encoded.
193             #pod
194             #pod =cut
195              
196             has auth_mechanism_properties => (
197             is => 'lazy',
198             isa => HashRef,
199             builder => '_build_auth_mechanism_properties',
200             );
201              
202             sub _build_auth_mechanism_properties {
203 188     188   9421 my ($self) = @_;
204 188         667 return $self->__uri_or_else(
205             u => 'authmechanismproperties',
206             e => 'auth_mechanism_properties',
207             d => {},
208             );
209             }
210              
211             #pod =attr bson_codec
212             #pod
213             #pod An object that provides the C and C methods, such as
214             #pod from L. It may be initialized with a hash reference that will
215             #pod be coerced into a new L object.
216             #pod
217             #pod If not provided, a L object with default values will be generated.
218             #pod
219             #pod =cut
220              
221             has bson_codec => (
222             is => 'lazy',
223             isa => BSONCodec,
224             coerce => BSONCodec->coercion,
225             writer => '_set_bson_codec',
226             builder => '_build_bson_codec',
227             );
228              
229             sub _build_bson_codec {
230 181     181   3344 my ($self) = @_;
231 181         2775 return BSON->new();
232             }
233              
234             #pod =attr compressors
235             #pod
236             #pod An array reference of compression type names. Currently, C, C and
237             #pod C are supported.
238             #pod
239             #pod =cut
240              
241             has compressors => (
242             is => 'lazy',
243             isa => ArrayRef[CompressionType],
244             builder => '_build_compressors',
245             );
246              
247             sub _build_compressors {
248 115     115   16576 my ($self) = @_;
249 115         389 return $self->__uri_or_else(
250             u => 'compressors',
251             e => 'compressors',
252             d => [],
253             );
254             }
255              
256             #pod =attr zlib_compression_level
257             #pod
258             #pod An integer from C<-1> to C<9> specifying the compression level to use
259             #pod when L is set to C.
260             #pod
261             #pod B: When the special value C<-1> is given, the default compression
262             #pod level will be used.
263             #pod
264             #pod =cut
265              
266             has zlib_compression_level => (
267             is => 'lazy',
268             isa => ZlibCompressionLevel,
269             builder => '_build_zlib_compression_level',
270             );
271              
272             sub _build_zlib_compression_level {
273 174     174   16043 my ($self) = @_;
274 174         905 return $self->__uri_or_else(
275             u => 'zlibcompressionlevel',
276             e => 'zlib_compression_level',
277             d => -1,
278             );
279             }
280              
281             #pod =attr connect_timeout_ms
282             #pod
283             #pod This attribute specifies the amount of time in milliseconds to wait for a
284             #pod new connection to a server.
285             #pod
286             #pod The default is 10,000 ms.
287             #pod
288             #pod If set to a negative value, connection operations will block indefinitely
289             #pod until the server replies or until the operating system TCP/IP stack gives
290             #pod up (e.g. if the name can't resolve or there is no process listening on the
291             #pod target host/port).
292             #pod
293             #pod A zero value polls the socket during connection and is thus likely to fail
294             #pod except when talking to a local process (and perhaps even then).
295             #pod
296             #pod This may be set in a connection string with the C option.
297             #pod
298             #pod =cut
299              
300             has connect_timeout_ms => (
301             is => 'lazy',
302             isa => Num,
303             builder => '_build_connect_timeout_ms',
304             );
305              
306             sub _build_connect_timeout_ms {
307 188     188   8521 my ($self) = @_;
308 188         576 return $self->__uri_or_else(
309             u => 'connecttimeoutms',
310             e => 'connect_timeout_ms',
311             d => 10000,
312             );
313             }
314              
315             #pod =attr db_name
316             #pod
317             #pod Optional. If an L requires a database for authentication,
318             #pod this attribute will be used. Otherwise, it will be ignored. Defaults to
319             #pod "admin".
320             #pod
321             #pod This may be provided in the L as
322             #pod a path between the authority and option parameter sections. For example, to
323             #pod authenticate against the "admin" database (showing a configuration option only
324             #pod for illustration):
325             #pod
326             #pod mongodb://localhost/admin?readPreference=primary
327             #pod
328             #pod =cut
329              
330             has db_name => (
331             is => 'lazy',
332             isa => Str,
333             builder => '_build_db_name',
334             );
335              
336             sub _build_db_name {
337 188     188   8784 my ($self) = @_;
338 188         2629 return __string( $self->_uri->db_name, $self->_deferred->{db_name} );
339             }
340              
341             #pod =attr heartbeat_frequency_ms
342             #pod
343             #pod The time in milliseconds (non-negative) between scans of all servers to
344             #pod check if they are up and update their latency. Defaults to 60,000 ms.
345             #pod
346             #pod This may be set in a connection string with the C option.
347             #pod
348             #pod =cut
349              
350             has heartbeat_frequency_ms => (
351             is => 'lazy',
352             isa => HeartbeatFreq,
353             builder => '_build_heartbeat_frequency_ms',
354             );
355              
356             sub _build_heartbeat_frequency_ms {
357 188     188   8608 my ($self) = @_;
358 188         594 return $self->__uri_or_else(
359             u => 'heartbeatfrequencyms',
360             e => 'heartbeat_frequency_ms',
361             d => 60000,
362             );
363             }
364              
365             #pod =attr j
366             #pod
367             #pod If true, the client will block until write operations have been committed to the
368             #pod server's journal. Prior to MongoDB 2.6, this option was ignored if the server was
369             #pod running without journaling. Starting with MongoDB 2.6, write operations will fail
370             #pod if this option is used when the server is running without journaling.
371             #pod
372             #pod This may be set in a connection string with the C option as the
373             #pod strings 'true' or 'false'.
374             #pod
375             #pod =cut
376              
377             has j => (
378             is => 'lazy',
379             isa => Boolish,
380             builder => '_build_j',
381             );
382              
383             sub _build_j {
384 187     187   11222 my ($self) = @_;
385 187         627 return $self->__uri_or_else(
386             u => 'journal',
387             e => 'j',
388             d => undef,
389             );
390             }
391              
392             #pod =attr local_threshold_ms
393             #pod
394             #pod The width of the 'latency window': when choosing between multiple suitable
395             #pod servers for an operation, the acceptable delta in milliseconds
396             #pod (non-negative) between shortest and longest average round-trip times.
397             #pod Servers within the latency window are selected randomly.
398             #pod
399             #pod Set this to "0" to always select the server with the shortest average round
400             #pod trip time. Set this to a very high value to always randomly choose any known
401             #pod server.
402             #pod
403             #pod Defaults to 15 ms.
404             #pod
405             #pod See L for more details.
406             #pod
407             #pod This may be set in a connection string with the C option.
408             #pod
409             #pod =cut
410              
411             has local_threshold_ms => (
412             is => 'lazy',
413             isa => NonNegNum,
414             builder => '_build_local_threshold_ms',
415             );
416              
417             sub _build_local_threshold_ms {
418 187     187   8107 my ($self) = @_;
419 187         567 return $self->__uri_or_else(
420             u => 'localthresholdms',
421             e => 'local_threshold_ms',
422             d => 15,
423             );
424             }
425              
426             #pod =attr max_staleness_seconds
427             #pod
428             #pod The C parameter represents the maximum replication lag in
429             #pod seconds (wall clock time) that a secondary can suffer and still be
430             #pod eligible for reads. The default is -1, which disables staleness checks.
431             #pod Otherwise, it must be a positive integer.
432             #pod
433             #pod B: this will only be used for server versions 3.4 or greater, as that
434             #pod was when support for staleness tracking was added.
435             #pod
436             #pod If the read preference mode is 'primary', then C must not
437             #pod be supplied.
438             #pod
439             #pod The C must be at least the C
440             #pod plus 10 seconds (which is how often the server makes idle writes to the
441             #pod oplog).
442             #pod
443             #pod This may be set in a connection string with the C option.
444             #pod
445             #pod =cut
446              
447             has max_staleness_seconds => (
448             is => 'lazy',
449             isa => MaxStalenessNum,
450             builder => '_build_max_staleness_seconds',
451             );
452              
453             sub _build_max_staleness_seconds {
454 187     187   8889 my ($self) = @_;
455 187         653 return $self->__uri_or_else(
456             u => 'maxstalenessseconds',
457             e => 'max_staleness_seconds',
458             d => -1,
459             );
460             }
461              
462             #pod =attr max_time_ms
463             #pod
464             #pod Specifies the maximum amount of time in (non-negative) milliseconds that the
465             #pod server should use for working on a database command. Defaults to 0, which disables
466             #pod this feature. Make sure this value is shorter than C.
467             #pod
468             #pod B: this will only be used for server versions 2.6 or greater, as that
469             #pod was when the C<$maxTimeMS> meta-operator was introduced.
470             #pod
471             #pod You are B encouraged to set this variable if you know your
472             #pod environment has MongoDB 2.6 or later, as getting a definitive error response
473             #pod from the server is vastly preferred over a getting a network socket timeout.
474             #pod
475             #pod This may be set in a connection string with the C option.
476             #pod
477             #pod =cut
478              
479             has max_time_ms => (
480             is => 'lazy',
481             isa => NonNegNum,
482             builder => '_build_max_time_ms',
483             );
484              
485             sub _build_max_time_ms {
486 187     187   9002 my ($self) = @_;
487 187         552 return $self->__uri_or_else(
488             u => 'maxtimems',
489             e => 'max_time_ms',
490             d => 0,
491             );
492             }
493              
494             #pod =attr monitoring_callback
495             #pod
496             #pod Specifies a code reference used to receive monitoring events. See
497             #pod L for more details.
498             #pod
499             #pod =cut
500              
501             has monitoring_callback => (
502             is => 'ro',
503             isa => Maybe [CodeRef],
504             );
505              
506             #pod =attr password
507             #pod
508             #pod If an L requires a password, this attribute will be
509             #pod used. Otherwise, it will be ignored.
510             #pod
511             #pod This may be provided in the L as
512             #pod a C pair in the leading portion of the authority section
513             #pod before a C<@> character. For example, to authenticate as user "mulder" with
514             #pod password "trustno1":
515             #pod
516             #pod mongodb://mulder:trustno1@localhost
517             #pod
518             #pod If the username or password have a ":" or "@" in it, they must be URL encoded.
519             #pod An empty password still requires a ":" character.
520             #pod
521             #pod =cut
522              
523             has password => (
524             is => 'lazy',
525             isa => Str,
526             builder => '_build_password',
527             );
528              
529             sub _build_password {
530 187     187   11962 my ($self) = @_;
531             return
532             defined( $self->_uri->password ) ? $self->_uri->password
533             : defined( $self->_deferred->{password} ) ? $self->_deferred->{password}
534 187 100       2749 : '';
    100          
535             }
536              
537             #pod =attr port
538             #pod
539             #pod If a network port is not specified as part of the C attribute, this
540             #pod attribute provides the port to use. It defaults to 27107.
541             #pod
542             #pod =cut
543              
544             has port => (
545             is => 'ro',
546             isa => Int,
547             default => 27017,
548             );
549              
550             #pod =attr read_concern_level
551             #pod
552             #pod The read concern level determines the consistency level required
553             #pod of data being read.
554             #pod
555             #pod The default level is C, which means the server will use its configured
556             #pod default.
557             #pod
558             #pod If the level is set to "local", reads will return the latest data a server has
559             #pod locally.
560             #pod
561             #pod Additional levels are storage engine specific. See L
562             #pod Concern|http://docs.mongodb.org/manual/search/?query=readConcern> in the MongoDB
563             #pod documentation for more details.
564             #pod
565             #pod This may be set in a connection string with the the C option.
566             #pod
567             #pod =cut
568              
569             has read_concern_level => (
570             is => 'lazy',
571             isa => Maybe [Str],
572             builder => '_build_read_concern_level',
573             );
574              
575             sub _build_read_concern_level {
576 186     186   8672 my ($self) = @_;
577 186         539 return $self->__uri_or_else(
578             u => 'readconcernlevel',
579             e => 'read_concern_level',
580             d => undef,
581             );
582             }
583              
584             #pod =attr read_pref_mode
585             #pod
586             #pod The read preference mode determines which server types are candidates
587             #pod for a read operation. Valid values are:
588             #pod
589             #pod =for :list
590             #pod * primary
591             #pod * primaryPreferred
592             #pod * secondary
593             #pod * secondaryPreferred
594             #pod * nearest
595             #pod
596             #pod For core documentation on read preference see
597             #pod L.
598             #pod
599             #pod This may be set in a connection string with the C option.
600             #pod
601             #pod =cut
602              
603             has read_pref_mode => (
604             is => 'lazy',
605             isa => ReadPrefMode,
606             coerce => ReadPrefMode->coercion,
607             builder => '_build_read_pref_mode',
608             );
609              
610             sub _build_read_pref_mode {
611 187     187   10197 my ($self) = @_;
612 187         567 return $self->__uri_or_else(
613             u => 'readpreference',
614             e => 'read_pref_mode',
615             d => 'primary',
616             );
617             }
618              
619             #pod =attr read_pref_tag_sets
620             #pod
621             #pod The C parameter is an ordered list of tag sets used to
622             #pod restrict the eligibility of servers, such as for data center awareness. It
623             #pod must be an array reference of hash references.
624             #pod
625             #pod The application of C varies depending on the
626             #pod C parameter. If the C is 'primary', then
627             #pod C must not be supplied.
628             #pod
629             #pod For core documentation on read preference see
630             #pod L.
631             #pod
632             #pod This may be set in a connection string with the C option.
633             #pod If given, the value must be key/value pairs joined with a ":". Multiple pairs
634             #pod must be separated by a comma. If ": or "," appear in a key or value, they must
635             #pod be URL encoded. The C option may appear more than once, in
636             #pod which case each document will be added to the tag set list.
637             #pod
638             #pod =cut
639              
640             has read_pref_tag_sets => (
641             is => 'lazy',
642             isa => ArrayOfHashRef,
643             coerce => ArrayOfHashRef->coercion,
644             builder => '_build_read_pref_tag_sets',
645             );
646              
647             sub _build_read_pref_tag_sets {
648 187     187   16931 my ($self) = @_;
649 187         666 return $self->__uri_or_else(
650             u => 'readpreferencetags',
651             e => 'read_pref_tag_sets',
652             d => [ {} ],
653             );
654             }
655              
656             #pod =attr replica_set_name
657             #pod
658             #pod Specifies the replica set name to connect to. If this string is non-empty,
659             #pod then the topology is treated as a replica set and all server replica set
660             #pod names must match this or they will be removed from the topology.
661             #pod
662             #pod This may be set in a connection string with the C option.
663             #pod
664             #pod =cut
665              
666             has replica_set_name => (
667             is => 'lazy',
668             isa => Str,
669             builder => '_build_replica_set_name',
670             );
671              
672             sub _build_replica_set_name {
673 187     187   14346 my ($self) = @_;
674 187         569 return $self->__uri_or_else(
675             u => 'replicaset',
676             e => 'replica_set_name',
677             d => '',
678             );
679             }
680              
681             #pod =attr retry_reads
682             #pod
683             #pod =cut
684              
685             has retry_reads => (
686             is => 'lazy',
687             isa => Boolish,
688             builder => '_build_retry_reads',
689             );
690              
691             sub _build_retry_reads {
692 187     187   8424 my ( $self ) = @_;
693 187         540 return $self->__uri_or_else(
694             u => 'retryreads',
695             e => 'retry_reads',
696             d => 1,
697             );
698             }
699              
700             #pod =attr retry_writes
701             #pod
702             #pod Whether the client should use retryable writes for supported commands. The
703             #pod default value is true, which means that commands which support retryable writes
704             #pod will be retried on certain errors, such as C and C
705             #pod recovering> errors.
706             #pod
707             #pod This may be set in a connection string with the C option.
708             #pod
709             #pod Note that this is only supported on MongoDB > 3.6 in Replica Set or Shard
710             #pod Clusters, and will be ignored on other deployments.
711             #pod
712             #pod Unacknowledged write operations also do not support retryable writes, even when
713             #pod retry_writes has been enabled.
714             #pod
715             #pod The supported single statement write operations are currently as follows:
716             #pod
717             #pod =for :list
718             #pod * C
719             #pod * C
720             #pod * C
721             #pod * C
722             #pod * C
723             #pod * C
724             #pod * C
725             #pod
726             #pod The supported multi statement write operations are as follows:
727             #pod
728             #pod =for :list
729             #pod * C
730             #pod * C
731             #pod
732             #pod The multi statement operations may be ether ordered or unordered. Note that for
733             #pod C operations, the request may not include update_many or
734             #pod delete_many operations.
735             #pod
736             #pod =cut
737              
738             has retry_writes => (
739             is => 'lazy',
740             isa => Boolish,
741             builder => '_build_retry_writes',
742             );
743              
744             sub _build_retry_writes {
745 187     187   8314 my ( $self ) = @_;
746 187         551 return $self->__uri_or_else(
747             u => 'retrywrites',
748             e => 'retry_writes',
749             d => 1,
750             );
751             }
752              
753             #pod =attr server_selection_timeout_ms
754             #pod
755             #pod This attribute specifies the amount of time in milliseconds to wait for a
756             #pod suitable server to be available for a read or write operation. If no
757             #pod server is available within this time period, an exception will be thrown.
758             #pod
759             #pod The default is 30,000 ms.
760             #pod
761             #pod See L for more details.
762             #pod
763             #pod This may be set in a connection string with the C
764             #pod option.
765             #pod
766             #pod =cut
767              
768             has server_selection_timeout_ms => (
769             is => 'lazy',
770             isa => Num,
771             builder => '_build_server_selection_timeout_ms',
772             );
773              
774             sub _build_server_selection_timeout_ms {
775 187     187   8010 my ($self) = @_;
776 187         552 return $self->__uri_or_else(
777             u => 'serverselectiontimeoutms',
778             e => 'server_selection_timeout_ms',
779             d => 30000,
780             );
781             }
782              
783             #pod =attr server_selection_try_once
784             #pod
785             #pod This attribute controls whether the client will make only a single attempt
786             #pod to find a suitable server for a read or write operation. The default is true.
787             #pod
788             #pod When true, the client will B use the C.
789             #pod Instead, if the topology information is stale and needs to be checked or
790             #pod if no suitable server is available, the client will make a single
791             #pod scan of all known servers to try to find a suitable one.
792             #pod
793             #pod When false, the client will continually scan known servers until a suitable
794             #pod server is found or the C is reached.
795             #pod
796             #pod See L for more details.
797             #pod
798             #pod This may be set in a connection string with the C
799             #pod option.
800             #pod
801             #pod =cut
802              
803             has server_selection_try_once => (
804             is => 'lazy',
805             isa => Boolish,
806             builder => '_build_server_selection_try_once',
807             );
808              
809             sub _build_server_selection_try_once {
810 187     187   8672 my ($self) = @_;
811 187         608 return $self->__uri_or_else(
812             u => 'serverselectiontryonce',
813             e => 'server_selection_try_once',
814             d => 1,
815             );
816             }
817              
818             #pod =attr server_selector
819             #pod
820             #pod Optional. This takes a function that augments the server selection rules.
821             #pod The function takes as a parameter a list of server descriptions representing
822             #pod the suitable servers for the read or write operation, and returns a list of
823             #pod server descriptions that should still be considered suitable. Most users
824             #pod should rely on the default server selection algorithm and should not need
825             #pod to set this attribute.
826             #pod
827             #pod =cut
828              
829             has server_selector => (
830             is => 'ro',
831             isa => Maybe[CodeRef],
832             );
833              
834             #pod =attr socket_check_interval_ms
835             #pod
836             #pod If a socket to a server has not been used in this many milliseconds, an
837             #pod C command will be issued to check the status of the server before
838             #pod issuing any reads or writes. Must be non-negative.
839             #pod
840             #pod The default is 5,000 ms.
841             #pod
842             #pod This may be set in a connection string with the C
843             #pod option.
844             #pod
845             #pod =cut
846              
847             has socket_check_interval_ms => (
848             is => 'lazy',
849             isa => NonNegNum,
850             builder => '_build_socket_check_interval_ms',
851             );
852              
853             sub _build_socket_check_interval_ms {
854 187     187   8032 my ($self) = @_;
855 187         558 return $self->__uri_or_else(
856             u => 'socketcheckintervalms',
857             e => 'socket_check_interval_ms',
858             d => 5000,
859             );
860             }
861              
862             #pod =attr socket_timeout_ms
863             #pod
864             #pod This attribute specifies the amount of time in milliseconds to wait for a
865             #pod reply from the server before issuing a network exception.
866             #pod
867             #pod The default is 30,000 ms.
868             #pod
869             #pod If set to a negative value, socket operations will block indefinitely
870             #pod until the server replies or until the operating system TCP/IP stack
871             #pod gives up.
872             #pod
873             #pod The driver automatically sets the TCP keepalive option when initializing the
874             #pod socket. For keepalive related issues, check the MongoDB documentation for
875             #pod L.
876             #pod
877             #pod A zero value polls the socket for available data and is thus likely to fail
878             #pod except when talking to a local process (and perhaps even then).
879             #pod
880             #pod This may be set in a connection string with the C option.
881             #pod
882             #pod =cut
883              
884             has socket_timeout_ms => (
885             is => 'lazy',
886             isa => Num,
887             builder => '_build_socket_timeout_ms',
888             );
889              
890             sub _build_socket_timeout_ms {
891 187     187   9206 my ($self) = @_;
892 187         589 return $self->__uri_or_else(
893             u => 'sockettimeoutms',
894             e => 'socket_timeout_ms',
895             d => 30000,
896             );
897             }
898              
899             #pod =attr ssl
900             #pod
901             #pod ssl => 1
902             #pod ssl => \%ssl_options
903             #pod
904             #pod This tells the driver that you are connecting to an SSL mongodb instance.
905             #pod
906             #pod You must have L 1.42+ and L 1.49+ installed for
907             #pod SSL support.
908             #pod
909             #pod The C attribute takes either a boolean value or a hash reference of
910             #pod options to pass to IO::Socket::SSL. For example, to set a CA file to validate
911             #pod the server certificate and set a client certificate for the server to validate,
912             #pod you could set the attribute like this:
913             #pod
914             #pod ssl => {
915             #pod SSL_ca_file => "/path/to/ca.pem",
916             #pod SSL_cert_file => "/path/to/client.pem",
917             #pod }
918             #pod
919             #pod If C is not provided, server certificates are verified against a
920             #pod default list of CAs, either L or an operating-system-specific
921             #pod default CA file. To disable verification, you can use
922             #pod C<< SSL_verify_mode => 0x00 >>.
923             #pod
924             #pod B.
925             #pod
926             #pod Server hostnames are also validated against the CN name in the server
927             #pod certificate using C<< SSL_verifycn_scheme => 'http' >>. You can use the
928             #pod scheme 'none' to disable this check.
929             #pod
930             #pod B
931             #pod recommended>.
932             #pod
933             #pod This may be set to the string 'true' or 'false' in a connection string with the
934             #pod C option, which will enable ssl with default configuration. (See
935             #pod L for additional TLS
936             #pod configuration options.)
937             #pod
938             #pod =cut
939              
940             has ssl => (
941             is => 'lazy',
942             isa => Boolish|HashRef,
943             builder => '_build_ssl',
944             );
945              
946             sub _build_ssl {
947 187     187   8959 my ($self) = @_;
948              
949             # options will be undef if not provided
950 187         624 my $uri_ssl = $self->__ssl_from_uri();
951 187 100       989 my $opt_ssl = exists $self->_deferred->{ssl} ? $self->_deferred->{ssl} : undef;
952              
953             # no SSL options exist
954 187 100 100     975 if ( !defined $uri_ssl && !defined $opt_ssl ) {
955 184         2952 return 0;
956             }
957              
958             # validate deferred ssl arg type
959 3 50 66     17 if ( ref $opt_ssl && ref $opt_ssl ne 'HASH' ) {
960 0         0 MongoDB::UsageError->throw("ssl attribute must be scalar or hashref")
961             }
962              
963             # no URI SSL defined means use opts SSL
964 3 100       8 if ( !defined $uri_ssl ) {
965 2         29 return $opt_ssl;
966             }
967              
968             # if URI SSL is false, that takes precedence
969 1 50       4 if ( ! $uri_ssl ) {
970 1         15 return $uri_ssl;
971             }
972              
973             # if opt SSL isn't a hashref, it's irrelevant
974 0 0       0 if ( ref $opt_ssl ne 'HASH' ) {
975 0         0 return $uri_ssl;
976             }
977              
978             # if uri SSL isn't a hashref, we prefer opt SSL hashref
979 0 0       0 if ( ref $uri_ssl ne 'HASH' ) {
980 0         0 return $opt_ssl;
981             }
982              
983             # both are hashes, so merge them with URI taking precedence
984 0         0 return { %$opt_ssl, %$uri_ssl };
985             }
986              
987             my @tls_options = qw(
988             tlsallowinvalidcertificates
989             tlsallowinvalidhostnames
990             tlscafile
991             tlscertificatekeyfile
992             tlscertificatekeyfilepassword
993             tlsinsecure
994             );
995              
996             sub __ssl_from_uri {
997 187     187   419 my ($self) = @_;
998 187         2797 my $uri_options = $self->_uri->options;
999 187         1370 my $saw_tls_boolean = exists $uri_options->{tls};
1000 187         465 my $saw_tls_options = grep { length } map { exists $uri_options->{$_} } @tls_options;
  1122         1506  
  1122         2398  
1001              
1002 187 50       680 if (!$saw_tls_options) {
1003 187 100       683 return $saw_tls_boolean ? $uri_options->{tls} : undef;
1004             }
1005              
1006 0         0 my $ssl = {};
1007 0 0       0 if (exists($uri_options->{tlscafile})) {
1008 0         0 $ssl->{SSL_ca_file} = $uri_options->{tlscafile};
1009             }
1010 0 0       0 if (exists($uri_options->{tlscertificatekeyfile})) {
1011 0         0 $ssl->{SSL_cert_file} = $uri_options->{tlscertificatekeyfile};
1012             }
1013 0 0       0 if (exists($uri_options->{tlscertificatekeyfilepassword})) {
1014 0     0   0 $ssl->{SSL_passwd_cb} = sub { $uri_options->{tlscertificatekeyfilepassword} };
  0         0  
1015             }
1016 0 0       0 if (exists($uri_options->{tlsallowinvalidhostnames})) {
1017 0         0 $ssl->{SSL_verifycn_scheme} = 'none';
1018             }
1019 0 0       0 if (exists($uri_options->{tlsallowinvalidcertificates})) {
1020 0         0 $ssl->{SSL_verify_mode} = 0x00;
1021             }
1022 0 0       0 if (exists($uri_options->{tlsinsecure})) {
1023 0         0 $ssl->{SSL_verify_mode} = 0x00;
1024 0         0 $ssl->{SSL_verifycn_scheme} = 'none';
1025             }
1026 0         0 return $ssl;
1027             }
1028              
1029             #pod =attr username
1030             #pod
1031             #pod Optional username for this client connection. If this field is set, the client
1032             #pod will attempt to authenticate when connecting to servers. Depending on the
1033             #pod L, the L field or other attributes will need to be
1034             #pod set for authentication to succeed.
1035             #pod
1036             #pod This may be provided in the L as
1037             #pod a C pair in the leading portion of the authority section
1038             #pod before a C<@> character. For example, to authenticate as user "mulder" with
1039             #pod password "trustno1":
1040             #pod
1041             #pod mongodb://mulder:trustno1@localhost
1042             #pod
1043             #pod If the username or password have a ":" or "@" in it, they must be URL encoded.
1044             #pod An empty password still requires a ":" character.
1045             #pod
1046             #pod =cut
1047              
1048             has username => (
1049             is => 'lazy',
1050             isa => Str,
1051             builder => '_build_username',
1052             );
1053              
1054             sub _build_username {
1055 188     188   2295 my ($self) = @_;
1056              
1057             return
1058             defined( $self->_uri->username ) ? $self->_uri->username
1059             : defined( $self->_deferred->{username} ) ? $self->_deferred->{username}
1060 188 100       2749 : '';
    100          
1061             }
1062              
1063             #pod =attr w
1064             #pod
1065             #pod The client I.
1066             #pod
1067             #pod =over 4
1068             #pod
1069             #pod =item * C<0> Unacknowledged. MongoClient will B wait for an acknowledgment that
1070             #pod the server has received and processed the request. Older documentation may refer
1071             #pod to this as "fire-and-forget" mode. This option is not recommended.
1072             #pod
1073             #pod =item * C<1> Acknowledged. MongoClient will wait until the
1074             #pod primary MongoDB acknowledges the write.
1075             #pod
1076             #pod =item * C<2> Replica acknowledged. MongoClient will wait until at least two
1077             #pod replicas (primary and one secondary) acknowledge the write. You can set a higher
1078             #pod number for more replicas.
1079             #pod
1080             #pod =item * C All replicas acknowledged.
1081             #pod
1082             #pod =item * C A majority of replicas acknowledged.
1083             #pod
1084             #pod =back
1085             #pod
1086             #pod If not set, the server default is used, which is typically "1".
1087             #pod
1088             #pod In MongoDB v2.0+, you can "tag" replica members. With "tagging" you can
1089             #pod specify a custom write concern For more information see L
1090             #pod Awareness|http://docs.mongodb.org/manual/data-center-awareness/>
1091             #pod
1092             #pod This may be set in a connection string with the C option.
1093             #pod
1094             #pod =cut
1095              
1096             has w => (
1097             is => 'lazy',
1098             isa => Int|Str|Undef,
1099             builder => '_build_w',
1100             );
1101              
1102             sub _build_w {
1103 187     187   13017 my ($self) = @_;
1104 187         582 return $self->__uri_or_else(
1105             u => 'w',
1106             e => 'w',
1107             d => undef,
1108             );
1109             }
1110              
1111             #pod =attr wtimeout
1112             #pod
1113             #pod The number of milliseconds an operation should wait for C secondaries to
1114             #pod replicate it.
1115             #pod
1116             #pod Defaults to 1000 (1 second). If you set this to undef, it could block indefinitely
1117             #pod (or until socket timeout is reached).
1118             #pod
1119             #pod See C above for more information.
1120             #pod
1121             #pod This may be set in a connection string with the C option.
1122             #pod
1123             #pod =cut
1124              
1125             has wtimeout => (
1126             is => 'lazy',
1127             isa => Maybe[Int],
1128             builder => '_build_wtimeout',
1129             );
1130              
1131             sub _build_wtimeout {
1132 186     186   8527 my ($self) = @_;
1133 186         534 return $self->__uri_or_else(
1134             u => 'wtimeoutms',
1135             e => 'wtimeout',
1136             d => 1000,
1137             );
1138             }
1139              
1140             #--------------------------------------------------------------------------#
1141             # computed attributes - these are private and can't be set in the
1142             # constructor, but have a public accessor
1143             #--------------------------------------------------------------------------#
1144              
1145             #pod =method read_preference
1146             #pod
1147             #pod Returns a L object constructed from
1148             #pod L and L
1149             #pod
1150             #pod B as a mutator has been removed.> Read
1151             #pod preference is read-only. If you need a different read preference for
1152             #pod a database or collection, you can specify that in C or
1153             #pod C.
1154             #pod
1155             #pod =cut
1156              
1157             has _read_preference => (
1158             is => 'lazy',
1159             isa => ReadPreference,
1160             reader => 'read_preference',
1161             init_arg => undef,
1162             builder => '_build__read_preference',
1163             );
1164              
1165             sub _build__read_preference {
1166 186     186   2060 my ($self) = @_;
1167 186 50       3763 return MongoDB::ReadPreference->new(
    50          
    50          
1168             ( defined $self->read_pref_mode ? ( mode => $self->read_pref_mode ) : () ),
1169             ( defined $self->read_pref_tag_sets ? ( tag_sets => $self->read_pref_tag_sets ) : () ),
1170             ( defined $self->max_staleness_seconds ? ( max_staleness_seconds => $self->max_staleness_seconds ) : () ),
1171             );
1172             }
1173              
1174             #pod =method write_concern
1175             #pod
1176             #pod Returns a L object constructed from L, L
1177             #pod and L.
1178             #pod
1179             #pod =cut
1180              
1181             has _write_concern => (
1182             is => 'lazy',
1183             isa => InstanceOf['MongoDB::WriteConcern'],
1184             reader => 'write_concern',
1185             init_arg => undef,
1186             builder => '_build__write_concern',
1187             );
1188              
1189             sub _build__write_concern {
1190 184     184   1936 my ($self) = @_;
1191              
1192 184         589 return MongoDB::WriteConcern->new( $self->_write_concern_options );
1193             }
1194              
1195             # Seperated out for use in transaction option defaults
1196             sub _write_concern_options {
1197 184     184   390 my ($self) = @_;
1198              
1199             return (
1200 184 100       2656 wtimeout => $self->wtimeout,
    100          
1201             # Must check for defined as w can be 0, and defaults to undef
1202             ( defined $self->w ? ( w => $self->w ) : () ),
1203             ( defined $self->j ? ( j => $self->j ) : () ),
1204             );
1205             }
1206              
1207              
1208             #pod =method read_concern
1209             #pod
1210             #pod Returns a L object constructed from
1211             #pod L.
1212             #pod
1213             #pod =cut
1214              
1215             has _read_concern => (
1216             is => 'lazy',
1217             isa => InstanceOf['MongoDB::ReadConcern'],
1218             reader => 'read_concern',
1219             init_arg => undef,
1220             builder => '_build__read_concern',
1221             );
1222              
1223             sub _build__read_concern {
1224 5     5   133 my ($self) = @_;
1225              
1226 5 100       79 return MongoDB::ReadConcern->new(
1227             ( $self->read_concern_level ?
1228             ( level => $self->read_concern_level ) : () ),
1229             );
1230             }
1231              
1232             #--------------------------------------------------------------------------#
1233             # private attributes
1234             #--------------------------------------------------------------------------#
1235              
1236             # used for a more accurate 'is this client the same one' for sessions, instead
1237             # of memory location which just feels... yucky
1238             has _id => (
1239             is => 'ro',
1240             init_arg => undef,
1241             default => sub { UUID::URandom::create_uuid_string() },
1242             );
1243              
1244             # collects constructor options and defer them so precedence can be resolved
1245             # against the _uri options; unlike other private args, this needs a valid
1246             # init argument
1247             has _deferred => (
1248             is => 'ro',
1249             isa => HashRef,
1250             init_arg => '_deferred',
1251             default => sub { {} },
1252             );
1253              
1254             #pod =method topology_type
1255             #pod
1256             #pod Returns an enumerated topology type. If the L is set,
1257             #pod the value will be either 'ReplicaSetWithPrimary' or 'ReplicaSetNoPrimary'
1258             #pod (if the primary is down or not yet discovered). Without
1259             #pod L, if there is more than one server in the list of
1260             #pod hosts, the type will be 'Sharded'.
1261             #pod
1262             #pod With only a single host and no replica set name, the topology type will
1263             #pod start as 'Direct' until the server is contacted the first time, after which
1264             #pod the type will be 'Sharded' for a mongos or 'Single' for standalone server
1265             #pod or direct connection to a replica set member.
1266             #pod
1267             #pod =cut
1268              
1269             has _topology => (
1270             is => 'lazy',
1271             isa => InstanceOf ['MongoDB::_Topology'],
1272             init_arg => undef,
1273             builder => '_build__topology',
1274             handles => {
1275             topology_type => 'type',
1276             _cluster_time => 'cluster_time',
1277             _update_cluster_time => 'update_cluster_time',
1278             },
1279             clearer => '_clear__topology',
1280             );
1281              
1282             sub _build__topology {
1283 183     183   2171 my ($self) = @_;
1284              
1285             my $type =
1286             length( $self->replica_set_name ) ? 'ReplicaSetNoPrimary'
1287 183 50       2743 : @{ $self->_uri->hostids } > 1 ? 'Sharded'
  181 100       4028  
1288             : 'Direct';
1289              
1290 183 50       4312 MongoDB::_Topology->new(
    50          
    100          
1291             uri => $self->_uri,
1292             type => $type,
1293             app_name => $self->app_name,
1294             replica_set_name => $self->replica_set_name,
1295             server_selection_timeout_sec => $self->server_selection_timeout_ms / 1000,
1296             server_selection_try_once => $self->server_selection_try_once,
1297             local_threshold_sec => $self->local_threshold_ms / 1000,
1298             heartbeat_frequency_sec => $self->heartbeat_frequency_ms / 1000,
1299             min_server_version => MIN_SERVER_VERSION,
1300             max_wire_version => MAX_WIRE_VERSION,
1301             min_wire_version => MIN_WIRE_VERSION,
1302             credential => $self->_credential,
1303             link_options => {
1304             connect_timeout => $self->connect_timeout_ms >= 0 ? $self->connect_timeout_ms / 1000
1305             : undef,
1306             socket_timeout => $self->socket_timeout_ms >= 0 ? $self->socket_timeout_ms / 1000
1307             : undef,
1308             with_ssl => !!$self->ssl,
1309             ( ref( $self->ssl ) eq 'HASH' ? ( SSL_options => $self->ssl ) : () ),
1310             },
1311             monitoring_callback => $self->monitoring_callback,
1312             compressors => $self->compressors,
1313             zlib_compression_level => $self->zlib_compression_level,
1314             socket_check_interval_sec => $self->socket_check_interval_ms / 1000,
1315             server_selector => $self->server_selector,
1316             );
1317             }
1318              
1319             has _credential => (
1320             is => 'lazy',
1321             isa => InstanceOf ['MongoDB::_Credential'],
1322             init_arg => undef,
1323             builder => '_build__credential',
1324             );
1325              
1326             sub _build__credential {
1327 183     183   24918 my ($self) = @_;
1328 183         2661 my $mechanism = $self->auth_mechanism;
1329 183         3587 my $uri_options = $self->_uri->options;
1330 183         1425 my $source = $uri_options->{authsource};
1331 183 100       3011 my $cred = MongoDB::_Credential->new(
    100          
    100          
    100          
1332             monitoring_callback => $self->monitoring_callback,
1333             mechanism => $mechanism,
1334             mechanism_properties => $self->auth_mechanism_properties,
1335             ( $self->username ? ( username => $self->username ) : () ),
1336             ( $self->password ? ( password => $self->password ) : () ),
1337             ( $source ? ( source => $source ) : () ),
1338             ( $self->db_name ? ( db_name => $self->db_name ) : () ),
1339             );
1340 174         3334 return $cred;
1341             }
1342              
1343             has _uri => (
1344             is => 'lazy',
1345             isa => InstanceOf ['MongoDB::_URI'],
1346             init_arg => undef,
1347             builder => '_build__uri',
1348             );
1349              
1350             sub _build__uri {
1351 189     189   2155 my ($self) = @_;
1352 189 100       1385 if ( $self->host =~ m{^[\w\+]+://} ) {
1353 132         2383 return MongoDB::_URI->new( uri => $self->host );
1354             }
1355             else {
1356             my $uri = $self->host =~ /:\d+$/
1357             ? $self->host
1358 57 100       469 : sprintf("%s:%s", map { $self->$_ } qw/host port/ );
  112         740  
1359 57         651 return MongoDB::_URI->new( uri => ("mongodb://$uri") );
1360             }
1361             }
1362              
1363             has _dispatcher => (
1364             is => 'lazy',
1365             isa => InstanceOf ['MongoDB::_Dispatcher'],
1366             init_arg => undef,
1367             builder => '_build__dispatcher',
1368             handles => [
1369             qw(
1370             send_direct_op
1371             send_primary_op
1372             send_retryable_read_op
1373             send_read_op
1374             send_retryable_write_op
1375             send_write_op
1376             )
1377             ],
1378             );
1379              
1380             sub _build__dispatcher {
1381 0     0   0 my $self = shift;
1382 0         0 return MongoDB::_Dispatcher->new(
1383             topology => $self->_topology,
1384             retry_writes => $self->retry_writes,
1385             retry_reads => $self->retry_reads,
1386             );
1387             }
1388              
1389             has _server_session_pool => (
1390             is => 'lazy',
1391             isa => InstanceOf['MongoDB::_SessionPool'],
1392             init_arg => undef,
1393             builder => '_build__server_session_pool',
1394             );
1395              
1396             sub _build__server_session_pool {
1397 0     0   0 my $self = shift;
1398 0         0 return MongoDB::_SessionPool->new(
1399             dispatcher => $self->_dispatcher,
1400             topology => $self->_topology,
1401             );
1402             }
1403              
1404             #--------------------------------------------------------------------------#
1405             # Constructor customization
1406             #--------------------------------------------------------------------------#
1407              
1408             # these attributes are lazy, built from either _uri->options or from
1409             # _config_options captured in BUILDARGS
1410             my @deferred_options = qw(
1411             app_name
1412             auth_mechanism
1413             auth_mechanism_properties
1414             connect_timeout_ms
1415             db_name
1416             heartbeat_frequency_ms
1417             j
1418             local_threshold_ms
1419             max_staleness_seconds
1420             max_time_ms
1421             read_pref_mode
1422             read_pref_tag_sets
1423             replica_set_name
1424             retry_writes
1425             retry_reads
1426             server_selection_timeout_ms
1427             server_selection_try_once
1428             socket_check_interval_ms
1429             socket_timeout_ms
1430             ssl
1431             username
1432             password
1433             w
1434             wtimeout
1435             read_concern_level
1436             );
1437              
1438             around BUILDARGS => sub {
1439             my $orig = shift;
1440             my $class = shift;
1441             my $hr = $class->$orig(@_);
1442             my $deferred = {};
1443             for my $k ( @deferred_options ) {
1444             $deferred->{$k} = delete $hr->{$k}
1445             if exists $hr->{$k};
1446             }
1447             $hr->{_deferred} = $deferred;
1448             return $hr;
1449             };
1450              
1451             sub BUILD {
1452 189     189 0 28940 my ($self, $opts) = @_;
1453              
1454 189         4169 my $uri = $self->_uri;
1455              
1456 189         4810 my @addresses = @{ $uri->hostids };
  189         862  
1457              
1458             # resolve and validate all deferred attributes
1459 189         3570 $self->$_ for @deferred_options;
1460              
1461             # resolve and validate read pref and write concern
1462 186         7519 $self->read_preference;
1463 184         7896 $self->write_concern;
1464              
1465             # Add error handler to codec if user didn't provide their own
1466 183 50       8001 unless ( $self->bson_codec->error_callback ) {
1467             $self->_set_bson_codec(
1468             $self->bson_codec->clone(
1469             error_callback => sub {
1470 0     0   0 my ($msg, $ref, $op) = @_;
1471 0 0       0 if ( $op =~ /^encode/ ) {
1472 0         0 MongoDB::DocumentError->throw(
1473             message => $msg,
1474             document => $ref
1475             );
1476             }
1477             else {
1478 0         0 MongoDB::DecodingError->throw($msg);
1479             }
1480             },
1481             )
1482 183         220359 );
1483             }
1484              
1485             # Instantiate topology
1486 183         39474 $self->_topology;
1487              
1488 174         6640 return;
1489             }
1490              
1491             #--------------------------------------------------------------------------#
1492             # helper functions
1493             #--------------------------------------------------------------------------#
1494              
1495             sub __uri_or_else {
1496 4220     4220   13202 my ( $self, %spec ) = @_;
1497 4220         61498 my $uri_options = $self->_uri->options;
1498 4220         29070 my $deferred = $self->_deferred;
1499 4220         8846 my ( $u, $e, $default ) = @spec{qw/u e d/};
1500             return
1501             exists $uri_options->{$u} ? $uri_options->{$u}
1502 4220 100       59967 : exists $deferred->{$e} ? $deferred->{$e}
    100          
1503             : $default;
1504             }
1505              
1506             sub __string {
1507 188     188   1897 local $_;
1508 188 100       531 my ($first) = grep { defined && length } @_;
  376         1626  
1509 188   100     3234 return $first || '';
1510             }
1511              
1512             #--------------------------------------------------------------------------#
1513             # public methods - network communication
1514             #--------------------------------------------------------------------------#
1515              
1516             #pod =method connect
1517             #pod
1518             #pod $client->connect;
1519             #pod
1520             #pod Calling this method is unnecessary, as connections are established
1521             #pod automatically as needed. It is kept for backwards compatibility. Calling it
1522             #pod will check all servers in the deployment which ensures a connection to any
1523             #pod that are available.
1524             #pod
1525             #pod See L for a method that is useful when using forks or threads.
1526             #pod
1527             #pod =cut
1528              
1529             sub connect {
1530 0     0 1   my ($self) = @_;
1531 0           $self->_topology->scan_all_servers;
1532 0           return 1;
1533             }
1534              
1535             #pod =method disconnect
1536             #pod
1537             #pod $client->disconnect;
1538             #pod
1539             #pod Drops all connections to servers.
1540             #pod
1541             #pod =cut
1542              
1543             sub disconnect {
1544 0     0 1   my ($self) = @_;
1545 0           $self->_topology->close_all_links;
1546 0           return 1;
1547             }
1548              
1549             #pod =method reconnect
1550             #pod
1551             #pod $client->reconnect;
1552             #pod
1553             #pod This method closes all connections to the server, as if L were
1554             #pod called, and then immediately reconnects. It also clears the session
1555             #pod cache. Use this after forking or spawning off a new thread.
1556             #pod
1557             #pod =cut
1558              
1559             sub reconnect {
1560 0     0 1   my ($self) = @_;
1561 0           $self->_topology->close_all_links;
1562 0           $self->_server_session_pool->reset_pool;
1563 0           $self->_topology->scan_all_servers(1);
1564 0           return 1;
1565             }
1566              
1567             #pod =method topology_status
1568             #pod
1569             #pod $client->topology_status;
1570             #pod $client->topology_status( refresh => 1 );
1571             #pod
1572             #pod Returns a hash reference with server topology information like this:
1573             #pod
1574             #pod {
1575             #pod 'topology_type' => 'ReplicaSetWithPrimary'
1576             #pod 'replica_set_name' => 'foo',
1577             #pod 'last_scan_time' => '1433766895.183241',
1578             #pod 'servers' => [
1579             #pod {
1580             #pod 'address' => 'localhost:50003',
1581             #pod 'ewma_rtt_ms' => '0.223462326',
1582             #pod 'type' => 'RSSecondary'
1583             #pod },
1584             #pod {
1585             #pod 'address' => 'localhost:50437',
1586             #pod 'ewma_rtt_ms' => '0.268435456',
1587             #pod 'type' => 'RSArbiter'
1588             #pod },
1589             #pod {
1590             #pod 'address' => 'localhost:50829',
1591             #pod 'ewma_rtt_ms' => '0.737782272',
1592             #pod 'type' => 'RSPrimary'
1593             #pod }
1594             #pod },
1595             #pod }
1596             #pod
1597             #pod If the 'refresh' argument is true, then the topology will be scanned
1598             #pod to update server data before returning the hash reference.
1599             #pod
1600             #pod =cut
1601              
1602             sub topology_status {
1603 0     0 1   my ($self, %opts) = @_;
1604 0 0         $self->_topology->scan_all_servers(1) if $opts{refresh};
1605 0           return $self->_topology->status_struct;
1606             }
1607              
1608             #pod =method start_session
1609             #pod
1610             #pod $client->start_session;
1611             #pod $client->start_session( $options );
1612             #pod
1613             #pod Returns a new L with the supplied options.
1614             #pod
1615             #pod will throw a C if sessions are not supported by
1616             #pod the connected MongoDB deployment.
1617             #pod
1618             #pod the options hash is an optional hash which can have the following keys:
1619             #pod
1620             #pod =for :list
1621             #pod * C - Enable Causally Consistent reads for this session.
1622             #pod Defaults to true.
1623             #pod
1624             #pod for more information see L.
1625             #pod
1626             #pod =cut
1627              
1628             sub start_session {
1629 0     0 1   my ( $self, $opts ) = @_;
1630              
1631 0 0         unless ( $self->_topology->_supports_sessions ) {
1632 0           MongoDB::ConfigurationError->throw( "Sessions are not supported by this MongoDB deployment" );
1633             }
1634              
1635 0           return $self->_start_client_session( 1, $opts );
1636             }
1637              
1638             sub _maybe_get_implicit_session {
1639 0     0     my ($self) = @_;
1640              
1641             # Dont return an error as implicit sessions need to be backwards compatible
1642 0 0         return undef unless $self->_topology->_supports_sessions; ## no critic
1643              
1644 0           return $self->_start_client_session(0);
1645             }
1646              
1647             sub _start_client_session {
1648 0     0     my ( $self, $is_explicit, $opts ) = @_;
1649              
1650 0   0       $opts ||= {};
1651              
1652 0           my $session = $self->_server_session_pool->get_server_session;
1653 0           return MongoDB::ClientSession->new(
1654             client => $self,
1655             options => $opts,
1656             _is_explicit => $is_explicit,
1657             server_session => $session,
1658             );
1659             }
1660              
1661             #--------------------------------------------------------------------------#
1662             # semi-private methods; these are public but undocumented and their
1663             # semantics might change in future releases
1664             #--------------------------------------------------------------------------#
1665              
1666             # Undocumented in old MongoDB::MongoClient; semantics don't translate, but
1667             # best approximation is checking if we can send a command to a server
1668             sub connected {
1669 0     0 0   my ($self) = @_;
1670 0           return eval { $self->send_admin_command([ismaster => 1]); 1 };
  0            
  0            
1671             }
1672              
1673             sub send_admin_command {
1674 0     0 0   my ( $self, $command, $read_pref ) = @_;
1675              
1676 0 0 0       $read_pref = MongoDB::ReadPreference->new(
    0          
1677             ref($read_pref) ? $read_pref : ( mode => $read_pref ) )
1678             if $read_pref && ref($read_pref) ne 'MongoDB::ReadPreference';
1679              
1680 0           my $op = MongoDB::Op::_Command->_new(
1681             db_name => 'admin',
1682             query => $command,
1683             query_flags => {},
1684             bson_codec => $self->bson_codec,
1685             read_preference => $read_pref,
1686             session => $self->_maybe_get_implicit_session,
1687             monitoring_callback => $self->monitoring_callback,
1688             );
1689              
1690 0           return $self->send_retryable_read_op( $op );
1691             }
1692              
1693             # Ostensibly the same as above, but allows for specific addressing - uses 'send_direct_op'.
1694             sub _send_direct_admin_command {
1695 0     0     my ( $self, $address, $command, $read_pref ) = @_;
1696              
1697 0 0 0       $read_pref = MongoDB::ReadPreference->new(
    0          
1698             ref($read_pref) ? $read_pref : ( mode => $read_pref ) )
1699             if $read_pref && ref($read_pref) ne 'MongoDB::ReadPreference';
1700              
1701 0           my $op = MongoDB::Op::_Command->_new(
1702             db_name => 'admin',
1703             query => $command,
1704             query_flags => {},
1705             bson_codec => $self->bson_codec,
1706             read_preference => $read_pref,
1707             session => $self->_maybe_get_implicit_session,
1708             monitoring_callback => $self->monitoring_callback,
1709             );
1710              
1711 0           return $self->send_direct_op( $op, $address );
1712             }
1713              
1714             #--------------------------------------------------------------------------#
1715             # database helper methods
1716             #--------------------------------------------------------------------------#
1717              
1718             #pod =method list_databases
1719             #pod
1720             #pod # get all information on all databases
1721             #pod my @dbs = $client->list_databases;
1722             #pod
1723             #pod # get only the foo databases
1724             #pod my @foo_dbs = $client->list_databases({ filter => { name => qr/^foo/ } });
1725             #pod
1726             #pod Lists all databases with information on each database. Supports filtering by
1727             #pod any of the output fields under the C argument, such as:
1728             #pod
1729             #pod =for :list
1730             #pod * C
1731             #pod * C
1732             #pod * C
1733             #pod * C
1734             #pod
1735             #pod =cut
1736              
1737             sub list_databases {
1738 0     0 1   my ( $self, $args ) = @_;
1739 0           my @databases;
1740             eval {
1741 0 0         my $output = $self->send_admin_command([ listDatabases => 1, ( $args ? %$args : () ) ])->output;
1742 0 0 0       if (ref($output) eq 'HASH' && exists $output->{databases}) {
1743 0           @databases = @{ $output->{databases} };
  0            
1744             }
1745 0           return 1;
1746 0 0         } or do {
1747 0   0       my $error = $@ || "Unknown error";
1748 0 0         if ( $error->$_isa("MongoDB::DatabaseError" ) ) {
1749 0 0         return if $error->result->output->{code} == CANT_OPEN_DB_IN_READ_LOCK();
1750             }
1751 0           die $error;
1752             };
1753 0           return @databases;
1754             }
1755              
1756             #pod =method database_names
1757             #pod
1758             #pod my @dbs = $client->database_names;
1759             #pod
1760             #pod # get only the foo database names
1761             #pod my @foo_dbs = $client->database_names({ filter => { name => qr/^foo/ } });
1762             #pod
1763             #pod List of all database names on the MongoDB server. Supports filters in the same
1764             #pod way as L.
1765             #pod
1766             #pod =cut
1767              
1768             sub database_names {
1769 0     0 1   my ( $self, $args ) = @_;
1770              
1771 0   0       $args ||= {};
1772 0           $args->{nameOnly} = 1;
1773 0           my @output = $self->list_databases($args);
1774              
1775 0           my @databases = map { $_->{name} } @output;
  0            
1776              
1777 0           return @databases;
1778             }
1779              
1780             #pod =method get_database, db
1781             #pod
1782             #pod my $database = $client->get_database('foo');
1783             #pod my $database = $client->get_database('foo', $options);
1784             #pod my $database = $client->db('foo', $options);
1785             #pod
1786             #pod Returns a L instance for the database with the given
1787             #pod C<$name>.
1788             #pod
1789             #pod It takes an optional hash reference of options that are passed to the
1790             #pod L constructor.
1791             #pod
1792             #pod The C method is an alias for C.
1793             #pod
1794             #pod =cut
1795              
1796             sub get_database {
1797 0     0 1   my ( $self, $database_name, $options ) = @_;
1798 0 0         return MongoDB::Database->new(
1799             read_preference => $self->read_preference,
1800             write_concern => $self->write_concern,
1801             read_concern => $self->read_concern,
1802             bson_codec => $self->bson_codec,
1803             max_time_ms => $self->max_time_ms,
1804             ( $options ? %$options : () ),
1805             # not allowed to be overridden by options
1806             _client => $self,
1807             name => $database_name,
1808             );
1809             }
1810              
1811 59     59   328572 { no warnings 'once'; *db = \&get_database }
  59         153  
  59         10548  
1812              
1813             #pod =method get_namespace, ns
1814             #pod
1815             #pod my $collection = $client->get_namespace('test.foo');
1816             #pod my $collection = $client->get_namespace('test.foo', $options);
1817             #pod my $collection = $client->ns('test.foo', $options);
1818             #pod
1819             #pod Returns a L instance for the given namespace.
1820             #pod The namespace has both the database name and the collection name
1821             #pod separated with a dot character.
1822             #pod
1823             #pod This is a quick way to get a collection object if you don't need
1824             #pod the database object separately.
1825             #pod
1826             #pod It takes an optional hash reference of options that are passed to the
1827             #pod L constructor. The intermediate L
1828             #pod object will be created with default options.
1829             #pod
1830             #pod The C method is an alias for C.
1831             #pod
1832             #pod =cut
1833              
1834             sub get_namespace {
1835 0     0 1   my ( $self, $ns, $options ) = @_;
1836 0 0 0       MongoDB::UsageError->throw("namespace requires a string argument")
1837             unless defined($ns) && length($ns);
1838 0           my ( $db, $coll ) = split /\./, $ns, 2;
1839 0 0 0       MongoDB::UsageError->throw("$ns is not a valid namespace")
1840             unless defined($db) && defined($coll);
1841 0           return $self->db($db)->coll( $coll, $options );
1842             }
1843              
1844 59     59   425 { no warnings 'once'; *ns = \&get_namespace }
  59         137  
  59         30879  
1845              
1846             #pod =method fsync(\%args)
1847             #pod
1848             #pod $client->fsync();
1849             #pod
1850             #pod A function that will forces the server to flush all pending writes to the storage layer.
1851             #pod
1852             #pod The fsync operation is synchronous by default, to run fsync asynchronously, use the following form:
1853             #pod
1854             #pod $client->fsync({async => 1});
1855             #pod
1856             #pod The primary use of fsync is to lock the database during backup operations. This will flush all data to the data storage layer and block all write operations until you unlock the database. Note: you can still read while the database is locked.
1857             #pod
1858             #pod $conn->fsync({lock => 1});
1859             #pod
1860             #pod =cut
1861              
1862             sub fsync {
1863 0     0 1   my ($self, $args) = @_;
1864              
1865 0   0       $args ||= {};
1866              
1867             # Pass this in as array-ref to ensure that 'fsync => 1' is the first argument.
1868 0           return $self->get_database('admin')->run_command([fsync => 1, %$args]);
1869             }
1870              
1871             #pod =method fsync_unlock
1872             #pod
1873             #pod $conn->fsync_unlock();
1874             #pod
1875             #pod Unlocks a database server to allow writes and reverses the operation of a $conn->fsync({lock => 1}); operation.
1876             #pod
1877             #pod =cut
1878              
1879             sub fsync_unlock {
1880 0     0 1   my ($self) = @_;
1881              
1882 0           my $op = MongoDB::Op::_FSyncUnlock->_new(
1883             db_name => 'admin',
1884             client => $self,
1885             bson_codec => $self->bson_codec,
1886             monitoring_callback => $self->monitoring_callback,
1887             );
1888              
1889 0           return $self->send_primary_op($op);
1890             }
1891              
1892             sub _get_session_from_hashref {
1893 0     0     my ( $self, $hashref ) = @_;
1894              
1895 0           my $session = delete $hashref->{session};
1896              
1897 0 0         if ( defined $session ) {
1898 0 0         MongoDB::UsageError->throw( "Cannot use session from another client" )
1899             if ( $session->client->_id ne $self->_id );
1900 0 0         MongoDB::UsageError->throw( "Cannot use session which has ended" )
1901             if ! defined $session->session_id;
1902             } else {
1903 0           $session = $self->_maybe_get_implicit_session;
1904             }
1905              
1906 0           return $session;
1907             }
1908              
1909             #pod =method watch
1910             #pod
1911             #pod Watches for changes on the cluster.
1912             #pod
1913             #pod Perform an aggregation with an implicit initial C<$changeStream> stage
1914             #pod and returns a L result which can be used to
1915             #pod iterate over the changes in the cluster. This functionality is
1916             #pod available since MongoDB 4.0.
1917             #pod
1918             #pod my $stream = $client->watch();
1919             #pod my $stream = $client->watch( \@pipeline );
1920             #pod my $stream = $client->watch( \@pipeline, \%options );
1921             #pod
1922             #pod while (1) {
1923             #pod
1924             #pod # This inner loop will only run until no more changes are
1925             #pod # available.
1926             #pod while (my $change = $stream->next) {
1927             #pod # process $change
1928             #pod }
1929             #pod }
1930             #pod
1931             #pod The returned stream will not block forever waiting for changes. If you
1932             #pod want to respond to changes over a longer time use C and
1933             #pod regularly call C in a loop.
1934             #pod
1935             #pod See L for details on usage and available
1936             #pod options.
1937             #pod
1938             #pod =cut
1939              
1940             sub watch {
1941 0     0 1   my ( $self, $pipeline, $options ) = @_;
1942              
1943 0   0       $pipeline ||= [];
1944 0   0       $options ||= {};
1945              
1946 0           my $session = $self->_get_session_from_hashref( $options );
1947              
1948             return MongoDB::ChangeStream->new(
1949             exists($options->{startAtOperationTime})
1950             ? (start_at_operation_time => delete $options->{startAtOperationTime})
1951             : (),
1952             exists($options->{fullDocument})
1953             ? (full_document => delete $options->{fullDocument})
1954             : (full_document => 'default'),
1955             exists($options->{resumeAfter})
1956             ? (resume_after => delete $options->{resumeAfter})
1957             : (),
1958             exists($options->{startAfter})
1959             ? (start_after => delete $options->{startAfter})
1960             : (),
1961             exists($options->{maxAwaitTimeMS})
1962             ? (max_await_time_ms => delete $options->{maxAwaitTimeMS})
1963 0 0         : (),
    0          
    0          
    0          
    0          
1964             client => $self,
1965             all_changes_for_cluster => 1,
1966             pipeline => $pipeline,
1967             session => $session,
1968             options => $options,
1969             op_args => {
1970             read_concern => $self->read_concern,
1971             db_name => 'admin',,
1972             coll_name => 1,
1973             full_name => 'admin.1',
1974             bson_codec => $self->bson_codec,
1975             write_concern => $self->write_concern,
1976             read_concern => $self->read_concern,
1977             read_preference => $self->read_preference,
1978             monitoring_callback => $self->monitoring_callback,
1979             },
1980             );
1981             }
1982              
1983             sub _primary_server_version {
1984 0     0     my $self = shift;
1985 0           my $build = $self->send_admin_command( [ buildInfo => 1 ] )->output;
1986 0           my ($version_str) = $build->{version} =~ m{^([0-9.]+)};
1987 0           return version->parse("v$version_str");
1988             }
1989              
1990             1;
1991              
1992             __END__