File Coverage

blib/lib/MongoDB/_Server.pm
Criterion Covered Total %
statement 79 92 85.8
branch 23 30 76.6
condition 14 16 87.5
subroutine 26 28 92.8
pod 0 4 0.0
total 142 170 83.5


line stmt bran cond sub pod time code
1             # Copyright 2014 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 61     61   74282 use strict;
  61         186  
  61         2090  
16 61     61   356 use warnings;
  61         151  
  61         2306  
17             package MongoDB::_Server;
18              
19 61     61   826 use version;
  61         2062  
  61         581  
20             our $VERSION = 'v2.2.1';
21              
22 61     61   5892 use Moo;
  61         10944  
  61         426  
23 61         409 use MongoDB::_Types qw(
24             Boolish
25             NonNegNum
26             HostAddress
27             ServerType
28             HostAddressList
29 61     61   24706 );
  61         174  
30 61         389 use Types::Standard qw(
31             InstanceOf
32             HashRef
33             Str
34             Num
35             Maybe
36 61     61   88039 );
  61         228  
37 61     61   69703 use List::Util qw/first/;
  61         165  
  61         4985  
38 61     61   938 use Time::HiRes qw/time/;
  61         1488  
  61         595  
39 61     61   8708 use namespace::clean -except => 'meta';
  61         10430  
  61         618  
40              
41             # address: the hostname or IP, and the port number, that the client connects
42             # to. Note that this is not the server's ismaster.me field, in the case that
43             # the server reports an address different from the address the client uses.
44              
45             has address => (
46             is => 'ro',
47             isa => HostAddress,
48             required => 1,
49             );
50              
51             # lastUpdateTime: when this server was last checked. Default "infinity ago".
52              
53             has last_update_time => (
54             is => 'ro',
55             isa => Num, # floating point time
56             required => 1,
57             );
58              
59             # error: information about the last error related to this server. Default null.
60              
61             has error => (
62             is => 'ro',
63             isa => Str,
64             default => '',
65             );
66              
67             # roundTripTime: the duration of the ismaster call. Default null.
68              
69             has rtt_sec => (
70             is => 'ro',
71             isa => NonNegNum,
72             default => 0,
73             );
74              
75             # is_master: hashref returned from an is_master command
76              
77             has is_master => (
78             is => 'ro',
79             isa => HashRef,
80             default => sub { {} },
81             );
82              
83             # compressor: hashref with id/callback values for used compression
84              
85             has compressor => (
86             is => 'ro',
87             isa => Maybe[HashRef],
88             );
89              
90             # type: a ServerType enum value. Default Unknown. Definitions from the Server
91             # Discovery and Monitoring Spec:
92             # - Unknown Initial, or after a network error or failed ismaster call, or "ok: 1"
93             # not in ismaster response.
94             # - Standalone No "msg: isdbgrid", no setName, and no "isreplicaset: true".
95             # - Mongos "msg: isdbgrid".
96             # - RSPrimary "ismaster: true", "setName" in response.
97             # - RSSecondary "secondary: true", "setName" in response.
98             # - RSArbiter "arbiterOnly: true", "setName" in response.
99             # - RSOther "setName" in response, "hidden: true" or not primary, secondary, nor arbiter.
100             # - RSGhost "isreplicaset: true" in response.
101             # - PossiblePrimary Not yet checked, but another member thinks it is the primary.
102              
103             has type => (
104             is => 'lazy',
105             isa => ServerType,
106             builder => '_build_type',
107             writer => '_set_type',
108             );
109              
110             sub _build_type {
111 543     543   5507 my ($self) = @_;
112 543         1315 my $is_master = $self->is_master;
113 543 100 66     2228 if ( !$is_master->{ok} ) {
    100          
    100          
    100          
114 325         5279 return 'Unknown';
115             }
116             elsif ( $is_master->{msg} && $is_master->{msg} eq 'isdbgrid' ) {
117 23         377 return 'Mongos';
118             }
119             elsif ( $is_master->{isreplicaset} ) {
120 3         75 return 'RSGhost';
121             }
122             elsif ( exists $is_master->{setName} ) {
123             return
124             $is_master->{ismaster} ? return 'RSPrimary'
125             : $is_master->{hidden} ? return 'RSOther'
126             : $is_master->{secondary} ? return 'RSSecondary'
127 171 100       1774 : $is_master->{arbiterOnly} ? return 'RSArbiter'
    100          
    100          
    100          
128             : 'RSOther';
129             }
130             else {
131 21         323 return 'Standalone';
132             }
133             }
134              
135             # hosts, passives, arbiters: Sets of addresses. This server's opinion of the
136             # replica set's members, if any. Default empty. The client monitors all three
137             # types of servers in a replica set.
138              
139             for my $s (qw/hosts passives arbiters/) {
140             has $s => (
141             is => 'lazy',
142             isa => HostAddressList,
143             builder => "_build_$s",
144             );
145              
146 61     61   43081 no strict 'refs'; ## no critic
  61         177  
  61         46028  
147             *{"_build_$s"} = sub {
148 867 100   867   50296 [ map { lc $_ } ( @{ $_[0]->is_master->{$s} || [] } ) ];
  196         2029  
  867         14569  
149             };
150             }
151              
152              
153             # address configured as part of replica set: string or null. Default null.
154              
155             has me => (
156             is => 'lazy',
157             isa => Str,
158             builder => "_build_me",
159             );
160              
161             sub _build_me {
162 289     289   15374 my ($self) = @_;
163 289   100     5012 return $self->is_master->{me} || '';
164             }
165              
166             # setName: string or null. Default null.
167              
168             has set_name => (
169             is => 'lazy',
170             isa => Str,
171             builder => "_build_set_name",
172             );
173              
174             sub _build_set_name {
175 188     188   203491 my ($self) = @_;
176 188   100     3491 return $self->is_master->{setName} || '';
177             }
178              
179             # primary: an address. This server's opinion of who the primary is. Default
180             # null.
181              
182             has primary => (
183             is => 'lazy',
184             isa => Str, # not HostAddress -- might be empty string
185             builder => "_build_primary",
186             );
187              
188             sub _build_primary {
189 289     289   20554 my ($self) = @_;
190 289   100     5122 return $self->is_master->{primary} || '';
191             }
192              
193             # tags: (a tag set) map from string to string. Default empty.
194              
195             has tags => (
196             is => 'lazy',
197             isa => HashRef,
198             builder => "_build_tags",
199             );
200              
201             sub _build_tags {
202 16     16   172 my ($self) = @_;
203 16   50     255 return $self->is_master->{tags} || {};
204             }
205              
206             # last_write_date: for replica set and wire version 5+ (converted to
207             # seconds)
208             has last_write_date => (
209             is => 'lazy',
210             isa => Num,
211             builder => "_build_last_write_date",
212             );
213              
214             sub _build_last_write_date {
215 54     54   440 my ($self) = @_;
216 54 50       147 return 0 unless exists $self->is_master->{lastWrite}{lastWriteDate};
217 54         158 return $self->is_master->{lastWrite}{lastWriteDate}->epoch;
218             }
219              
220             has is_available => (
221             is => 'lazy',
222             isa => Boolish,
223             builder => "_build_is_available",
224             );
225              
226             sub _build_is_available {
227 414     414   4190 my ($self) = @_;
228 414   100     6287 return $self->type ne 'Unknown' && $self->type ne 'PossiblePrimary';
229             }
230              
231             has is_readable => (
232             is => 'lazy',
233             isa => Boolish,
234             builder => "_build_is_readable",
235             );
236              
237             # any of these can take reads. Topologies will screen inappropriate
238             # ones out. E.g. "Standalone" won't be found in a replica set topology.
239             sub _build_is_readable {
240 0     0   0 my ($self) = @_;
241 0         0 my $type = $self->type;
242 0         0 return !! grep { $type eq $_ } qw/Standalone RSPrimary RSSecondary Mongos/;
  0         0  
243             }
244              
245             has is_writable => (
246             is => 'lazy',
247             isa => Boolish,
248             builder => "_build_is_writable",
249             );
250              
251             # any of these can take writes. Topologies will screen inappropriate
252             # ones out. E.g. "Standalone" won't be found in a replica set topology.
253             sub _build_is_writable {
254 30     30   245 my ($self) = @_;
255 30         395 my $type = $self->type;
256 30         187 return !! grep { $type eq $_ } qw/Standalone RSPrimary Mongos/;
  90         500  
257             }
258              
259             has is_data_bearing => (
260             is => 'lazy',
261             isa => Boolish,
262             builder => "_build_is_data_bearing",
263             );
264              
265             sub _build_is_data_bearing {
266 305     305   3347 my ( $self ) = @_;
267 305         4840 my $type = $self->type;
268 305         2437 return !! grep { $type eq $_ } qw/Standalone RSPrimary RSSecondary Mongos/;
  1220         6934  
269             }
270              
271             # logicalSessionTimeoutMinutes can be not set by a client
272             has logical_session_timeout_minutes => (
273             is => 'lazy',
274             isa => Maybe [NonNegNum],
275             builder => "_build_logical_session_timeout_minutes",
276             );
277              
278             sub _build_logical_session_timeout_minutes {
279 104     104   983 my ( $self ) = @_;
280 104   100     1836 return $self->is_master->{logicalSessionTimeoutMinutes} || undef;
281             }
282              
283             sub updated_since {
284 1188     1188 0 33896 my ( $self, $time ) = @_;
285 1188         16212 return( ($self->last_update_time - $time) > 0 );
286             }
287              
288             # check if server matches a single tag set (NOT a tag set list)
289             sub matches_tag_set {
290 58     58 0 94 my ( $self, $ts ) = @_;
291 61     61   528 no warnings 'uninitialized'; # let undef equal empty string without complaint
  61         167  
  61         21851  
292              
293 58         904 my $tg = $self->tags;
294              
295             # check if ts is a subset of tg: if any tags in ts that aren't in tg or where
296             # the tag values aren't equal mean ts is NOT a subset
297 58 50   60   765 if ( !defined first { !exists( $tg->{$_} ) || $tg->{$_} ne $ts->{$_} } keys %$ts ) {
  60 100       255  
298 30         149 return 1;
299             }
300              
301 28         143 return;
302             }
303              
304             sub status_string {
305 54     54 0 965 my ($self) = @_;
306 54 50       542 if ( my $err = $self->error ) {
307 54         286 $err =~ tr[\n][ ];
308             return
309 54         651 sprintf( "%s (type: %s, error: %s)", $self->{address}, $self->{type}, $err);
310             }
311             else {
312 0           return sprintf( "%s (type: %s)", map { $self->$_ } qw/address type/ );
  0            
313             }
314             }
315              
316             sub status_struct {
317 0     0 0   my ($self) = @_;
318 0           my $info = {
319             address => $self->address,
320             type => $self->type,
321             last_update_time => $self->last_update_time,
322             };
323 0 0         $info->{error} = $self->error if $self->error;
324 0 0         $info->{tags} = { %{ $self->tags } } if %{ $self->tags };
  0            
  0            
325 0           return $info;
326             }
327              
328              
329             1;
330              
331             # vim: ts=4 sts=4 sw=4 et: