qw/skip_unless_mongod build_client get_test_db server_type server_version/
;
skip_unless_mongod();
my
$conn
= build_client();
my
$testdb
= get_test_db(
$conn
);
my
$server_type
= server_type(
$conn
);
my
$server_version
= server_version(
$conn
);
my
$coll
=
$testdb
->get_collection(
"test_coll"
);
my
@modes
=
qw/primary secondary primaryPreferred secondaryPreferred nearest/
;
subtest
"read preference connection string"
=>
sub
{
my
$conn2
= build_client(
host
=>
);
my
$rp
=
$conn2
->read_preference;
is(
$rp
->mode,
'primaryPreferred'
,
"mode from"
);
is_deeply(
$rp
->tag_sets,
[ {
dc
=>
'ny'
,
rack
=> 1 }, {
dc
=>
'ny'
}, {} ],
"tag set list"
);
};
subtest
"read preference mode propagation"
=>
sub
{
for
my
$m
(
@modes
) {
my
$conn2
= build_client(
read_pref_mode
=>
$m
);
my
$db2
=
$conn2
->get_database(
$testdb
->name );
my
$coll2
=
$db2
->get_collection(
"test_coll"
);
my
$cur
=
$coll2
->find( {} );
for
my
$thing
(
$conn2
,
$db2
,
$coll2
) {
is(
$thing
->read_preference->mode,
$m
,
"$m set on "
.
ref
(
$thing
) );
}
is(
$cur
->_query->read_preference->mode,
$m
,
"$m set on "
.
ref
(
$cur
) );
}
};
subtest
"read preference staleness propagation"
=>
sub
{
my
$max
= 120;
my
$conn2
= build_client(
max_staleness_seconds
=>
$max
,
read_pref_mode
=>
'nearest'
);
my
$db2
=
$conn2
->get_database(
$testdb
->name );
my
$coll2
=
$db2
->get_collection(
"test_coll"
);
my
$cur
=
$coll2
->find( {} );
for
my
$thing
(
$conn2
,
$db2
,
$coll2
) {
is(
$thing
->read_preference->max_staleness_seconds,
$max
,
"staleness set on "
.
ref
(
$thing
) );
}
is(
$cur
->_query->read_preference->max_staleness_seconds,
$max
,
"staleness set on "
.
ref
(
$cur
) );
};
subtest
"max staleness vs heartbeat frequency"
=>
sub
{
plan
skip_all
=>
"Needs v3.3.8+ replica set"
unless
$server_type
eq
'RSPrimary'
&&
$server_version
>= v3.3.8;
my
$conn2
= build_client(
heartbeat_frequency_ms
=> 100_000,
max_staleness_seconds
=> 109,
read_pref_mode
=>
'nearest'
);
my
$db2
=
$conn2
->get_database(
$testdb
->name );
my
$coll2
=
$db2
->get_collection(
"test_coll"
);
like(
exception {
$coll2
->find({})->result; },
qr/max_staleness_seconds must be at least/
,
"max staleness less than heartbeat_frequency_ms + 10 throws"
);
};
subtest
"read preference on cursor"
=>
sub
{
for
my
$m
(
@modes
) {
my
$cur
=
$coll
->find()->read_preference(
$m
);
is(
$cur
->_query->read_preference->mode,
$m
,
"$m set on "
.
ref
(
$cur
) );
}
};
subtest
"error cases"
=>
sub
{
like(
exception {
$conn
->read_preference( MongoDB::ReadPreference->new ) },
qr/read-only/
,
"read_preference on client is read-only"
);
like(
exception {
build_client(
read_pref_mode
=>
'primary'
,
read_pref_tag_sets
=> [ {
use
=>
'production'
} ],
)
},
qr/A tag set list is not allowed with read preference mode 'primary'/
,
'primary cannot be combined with a tag set list'
);
};
subtest
'commands'
=>
sub
{
ok(
my
$conn2
= build_client(
read_preference
=>
'secondary'
),
"read pref set to secondary without error"
);
my
$admin
=
$conn2
->get_database(
'admin'
);
my
$testdb_name
=
$testdb
->name;
my
$db
=
$conn2
->get_database(
$testdb_name
);
my
$temp_coll
=
$db
->get_collection(
"foo"
);
$temp_coll
->insert_one({});
is(
exception {
$admin
->run_command(
[
renameCollection
=>
"$testdb_name\.foo"
,
to
=>
"$testdb_name\.foofoo"
] );
},
undef
,
"generic helper ran with primary read pref"
);
};
subtest
"direct connection"
=>
sub
{
plan
skip_all
=>
"Can't test with authentication enabled"
if
$conn
->auth_mechanism ne
'NONE'
;
my
$N
= 20;
$coll
->drop;
$coll
->insert_one({
'a'
=>
$_
})
for
1..
$N
;
for
my
$s
(
$conn
->_topology->all_servers ) {
next
unless
$s
->is_readable;
my
$addr
=
$s
->address;
my
$type
=
$s
->type;
my
$conn2
= build_client(
host
=>
$addr
);
my
$coll2
=
$conn2
->get_database(
$testdb
->name )->get_collection(
$coll
->name );
my
$count
;
is( exception {
$count
=
$coll2
->count_documents({}) },
undef
,
"count_documents on $addr ($type) succeeds"
)
or diag explain
$s
;
}
};
done_testing;