File Coverage

blib/lib/MongoDB/ReadPreference.pm
Criterion Covered Total %
statement 48 49 97.9
branch 11 14 78.5
condition 7 9 77.7
subroutine 13 13 100.0
pod 0 3 0.0
total 79 88 89.7


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   898 use strict;
  61         111  
  61         1679  
16 61     61   280 use warnings;
  61         114  
  61         1803  
17             package MongoDB::ReadPreference;
18              
19             # ABSTRACT: Encapsulate and validate read preferences
20              
21 61     61   610 use version;
  61         1677  
  61         357  
22             our $VERSION = 'v2.2.2';
23              
24 61     61   4600 use Moo;
  61         8780  
  61         340  
25 61     61   19276 use MongoDB::Error;
  61         145  
  61         6495  
26 61         463 use MongoDB::_Types qw(
27             ArrayOfHashRef
28             MaxStalenessNum
29             NonNegNum
30             ReadPrefMode
31 61     61   436 );
  61         124  
32 61     61   83669 use namespace::clean -except => 'meta';
  61         136  
  61         405  
33              
34             use overload (
35 222     222   791 q[""] => sub { $_[0]->mode },
36 61         532 fallback => 1,
37 61     61   36460 );
  61         129  
38              
39             #pod =attr mode
40             #pod
41             #pod The read preference mode determines which server types are candidates
42             #pod for a read operation. Valid values are:
43             #pod
44             #pod =for :list
45             #pod * primary
46             #pod * primaryPreferred
47             #pod * secondary
48             #pod * secondaryPreferred
49             #pod * nearest
50             #pod
51             #pod =cut
52              
53             has mode => (
54             is => 'ro',
55             isa => ReadPrefMode,
56             default => 'primary',
57             coerce => ReadPrefMode->coercion,
58             );
59              
60             #pod =attr tag_sets
61             #pod
62             #pod The C parameter is an ordered list of tag sets used to restrict the
63             #pod eligibility of servers, such as for data center awareness.
64             #pod
65             #pod The application of C varies depending on the C parameter. If
66             #pod the C is 'primary', then C must not be supplied.
67             #pod
68             #pod =cut
69              
70             has tag_sets => (
71             is => 'ro',
72             isa => ArrayOfHashRef,
73             default => sub { [ {} ] },
74             coerce => ArrayOfHashRef->coercion,
75             );
76              
77             #pod =attr max_staleness_seconds
78             #pod
79             #pod The C parameter represents the maximum replication lag in
80             #pod seconds (wall clock time) that a secondary can suffer and still be
81             #pod eligible for reads. The default is -1, which disables staleness checks.
82             #pod
83             #pod If the C is 'primary', then C must not be supplied.
84             #pod
85             #pod =cut
86              
87             has max_staleness_seconds => (
88             is => 'ro',
89             isa => MaxStalenessNum,
90             default => -1,
91             );
92              
93             sub BUILD {
94 509     509 0 77927 my ($self) = @_;
95              
96 509 100 100     2834 if ( $self->mode eq 'primary' && !$self->has_empty_tag_sets ) {
97 1         11 MongoDB::UsageError->throw("A tag set list is not allowed with read preference mode 'primary'");
98             }
99              
100 508 100 100     2588 if ( $self->mode eq 'primary' && $self->max_staleness_seconds > 0 ) {
101 4         31 MongoDB::UsageError->throw("A positive max_staleness_seconds is not allowed with read preference mode 'primary'");
102             }
103              
104 504         4933 return;
105             }
106              
107             # Returns true if the C array is empty or if it consists only of a
108             # single, empty hash reference.
109              
110             sub has_empty_tag_sets {
111 459     459 0 1058 my ($self) = @_;
112 459         1150 my $tag_sets = $self->tag_sets;
113 459   33     2235 return @$tag_sets == 0 || ( @$tag_sets == 1 && !keys %{ $tag_sets->[0] } );
114             }
115              
116             # Reformat to the document needed by mongos in $readPreference
117              
118             sub _as_hashref {
119 120     120   234 my ($self) = @_;
120             return {
121 120 50       337 mode => $self->mode,
    50          
122             ( $self->has_empty_tag_sets ? () : ( tags => $self->tag_sets ) ),
123             ( $self->max_staleness_seconds > 0 ? ( maxStalenessSeconds => int($self->max_staleness_seconds )) : () ),
124             };
125             }
126              
127             # Format as a string for error messages
128              
129             sub as_string {
130 3     3 0 11 my ($self) = @_;
131 3         7 my $string = $self->mode;
132 3 100       8 unless ( $self->has_empty_tag_sets ) {
133 1         2 my @ts;
134 1         38 for my $set ( @{ $self->tag_sets } ) {
  1         6  
135 3 100       14 push @ts, keys(%$set) ? join( ",", map { "$_\:$set->{$_}" } sort keys %$set ) : "";
  3         12  
136             }
137 1         3 $string .= " (" . join( ",", map { "{$_}" } @ts ) . ")";
  3         9  
138             }
139 3 50       70 if ( $self->max_staleness_seconds > 0) {
140 0         0 $string .= " ( maxStalenessSeconds: " . $self->max_staleness_seconds . " )";
141             }
142 3         13 return $string;
143             }
144              
145              
146             1;
147              
148             __END__