to_IxHash
/
;
use
if
$ENV
{MONGOVERBOSE},
qw/Log::Any::Adapter Stderr/
;
build_client
get_test_db
server_version
server_type
clear_testdbs
get_unique_collection
skip_unless_mongod
skip_unless_transactions
skip_unless_min_version
/
;
skip_unless_mongod();
skip_unless_transactions();
my
$conn
= build_client();
my
$server_version
= server_version(
$conn
);
my
$server_type
= server_type(
$conn
);
plan
skip_all
=>
"test is for mongos only"
unless
$conn
->_topology->type eq
'Sharded'
;
skip_unless_min_version(
$conn
,
'v4.1.6'
);
plan
skip_all
=>
"test deployment must have multiple named mongos"
if
scalar
(
$conn
->_topology->all_servers ) < 2;
my
$test_db
= get_test_db(
$conn
);
subtest
'Starting new transaction unpins client session'
=>
sub
{
my
$session
=
$conn
->start_session;
my
$collection
= get_unique_collection(
$test_db
,
'mongos-pinning-with'
);
$test_db
->run_command([
create
=>
$collection
->name ]);
$session
->start_transaction;
$collection
->insert_one({}, {
session
=>
$session
});
$session
->commit_transaction;
my
%addresses
;
for
( 0 .. 20 ) {
$session
->start_transaction;
my
$cursor
=
$collection
->find({}, {
session
=>
$session
});
my
$tmp
=
$cursor
->
next
;
$addresses
{
$cursor
->result->_address }++;
$session
->commit_transaction;
}
ok
scalar
(
keys
%addresses
) > 1,
'got more than one address for a sharded cluster'
;
$collection
->drop;
};
subtest
'Non transactions operations unpin session'
=>
sub
{
my
$session
=
$conn
->start_session;
my
$collection
= get_unique_collection(
$test_db
,
'mongos-pinning-non'
);
$test_db
->run_command([
create
=>
$collection
->name ]);
$session
->start_transaction;
$collection
->insert_one({}, {
session
=>
$session
});
$session
->commit_transaction;
my
%addresses
;
for
( 0 .. 20 ) {
my
$cursor
=
$collection
->find({}, {
session
=>
$session
});
my
$tmp
=
$cursor
->
next
;
$addresses
{
$cursor
->result->_address }++;
}
ok
scalar
(
keys
%addresses
) > 1,
'got more than one address for a sharded cluster'
;
$collection
->drop;
};
clear_testdbs;
done_testing;