use
MongoDBTest
qw/build_client get_test_db server_type/
;
my
$conn
= build_client();
my
$testdb
= get_test_db(
$conn
);
my
$server_type
= server_type(
$conn
);
my
$coll
=
$testdb
->get_collection(
"test_coll"
);
my
@modes
=
map
{ MongoDB::MongoClient->
$_
}
qw( PRIMARY SECONDARY PRIMARY_PREFERRED SECONDARY_PREFERRED 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 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 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
{
my
$N
= 20;
$coll
->drop;
$coll
->insert({
'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
,
connect_type
=>
'direct'
);
my
$coll2
=
$conn2
->get_database(
$testdb
->name )->get_collection(
$coll
->name );
my
$count
;
is( exception {
$count
=
$coll2
->count },
undef
,
"count on $addr ($type) succeeds"
)
or diag explain
$s
;
}
};
done_testing;