The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

MONGODB / MongoDB-v0.999.999.4-TRIAL / lib / MongoDB / Role / _ReadPrefModifier.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

              
#
#  Copyright 2014 MongoDB, Inc.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#  http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.
#
package MongoDB::Role::_ReadPrefModifier;
# MongoDB interface for read ops that respect read preference
use version;
our $VERSION = 'v0.999.999.4'; # TRIAL from MongoDB-v0.999.999.4-TRIAL.tar.gz
use Moo::Role;
use MongoDB::Error;
use Syntax::Keyword::Junction qw/any/;
use namespace::clean;
requires qw/query _set_query query_flags read_preference/;
sub _apply_read_prefs {
    my ( $self, $link, $topology_type ) = @_;
    $topology_type ||= "<undef>";
    my $read_pref = $self->read_preference;
    if ( $topology_type eq 'Single' ) {
        if ( $link->server && $link->server->type eq 'Mongos' ) {
            $self->_apply_mongos_read_prefs($read_pref);
        }
        else {
            $self->query_flags->{slave_ok} = 1;
        }
    }
    elsif ( $topology_type eq any(qw/ReplicaSetNoPrimary ReplicaSetWithPrimary/) ) {
        if ( !$read_pref || $read_pref->mode eq 'primary' ) {
            $self->query_flags->{slave_ok} = 0;
        }
        else {
            $self->query_flags->{slave_ok} = 1;
        }
    }
    elsif ( $topology_type eq 'Sharded' ) {
        $self->_apply_mongos_read_prefs($read_pref);
    }
    else {
        MongoDB::InternalError->throw("can't query topology type '$topology_type'");
    }
    return;
}
sub _apply_mongos_read_prefs {
    my ( $self, $read_pref ) = @_;
    my $mode = $read_pref ? $read_pref->mode : 'primary';
    my $need_read_pref;
    if ( $mode eq 'primary' ) {
        $self->query_flags->{slave_ok} = 0;
    }
    elsif ( $mode eq any(qw/secondary primaryPreferred nearest/) ) {
        $self->query_flags->{slave_ok} = 1;
        $need_read_pref = 1;
    }
    elsif ( $mode eq 'secondaryPreferred' ) {
        $self->query_flags->{slave_ok} = 1;
        $need_read_pref = 1
          unless $read_pref->has_empty_tag_sets;
    }
    else {
        MongoDB::InternalError->throw("invalid read preference mode '$mode'");
    }
    if ($need_read_pref) {
        if ( !$self->query->FETCH('$query') ) {
            $self->_set_query( Tie::IxHash->new( '$query' => $self->query ) );
        }
        $self->query->Push( '$readPreference' => $read_pref->for_mongos );
    }
    return;
}
1;