build_client
skip_unless_mongod
skip_unless_sessions
get_test_db
server_version
server_type
clear_testdbs
get_unique_collection
uuid_to_string
/
;
skip_unless_mongod();
skip_unless_sessions();
my
@events
;
sub
clear_events {
@events
= () }
sub
event_count {
scalar
@events
}
sub
event_cb {
push
@events
,
$_
[0] }
my
$conn
= build_client(
monitoring_callback
=> \
&event_cb
,
);
my
$testdb
= get_test_db(
$conn
);
my
$server_version
= server_version(
$conn
);
my
$server_type
= server_type(
$conn
);
my
$coll
=
$testdb
->get_collection(
'test_collection'
);
$coll
->insert_many( [
map
{ {
wanted
=> 1,
score
=>
$_
} } 0 .. 400 ] );
clear_events();
subtest
'Shared session in explicit cursor'
=>
sub
{
my
$session
=
$conn
->start_session;
my
$cursor
=
$coll
->find({
wanted
=> 1 }, {
batchSize
=> 100,
session
=>
$session
})->result;
my
$lsid
= uuid_to_string(
$session
->_server_session->session_id->{id}->data );
my
$cursor_command
=
$events
[-2]->{ command };
my
$cursor_command_sid
= uuid_to_string(
$cursor_command
->{
'lsid'
}->{id}->data );
is
$cursor_command_sid
,
$lsid
,
"Cursor sent with correct lsid"
;
my
$result_sid
= uuid_to_string(
$cursor
->_session->session_id->{id}->data );
is
$result_sid
,
$lsid
,
"Query Result contains correct session"
;
subtest
'All cursor calls in same session'
=>
sub
{
my
@items
=
$cursor
->batch;
while
(
@items
=
$cursor
->batch ) {
my
$command
=
$events
[-2]->{ command };
ok
exists
$command
->{
'lsid'
},
"cursor has session"
;
my
$cursor_session_id
= uuid_to_string(
$command
->{
'lsid'
}->{id}->data );
is
$cursor_session_id
,
$lsid
,
"Cursor is using given session"
;
}
};
$session
->end_session;
my
$retired_session_id
=
defined
$conn
->_server_session_pool->_server_session_pool->[0]
? uuid_to_string(
$conn
->_server_session_pool->_server_session_pool->[0]->session_id->{id}->data )
:
''
;
is
$retired_session_id
,
$lsid
,
"Session returned to pool"
;
};
clear_events();
subtest
'Shared session in implicit cursor'
=>
sub
{
my
$cursor
=
$coll
->find({
wanted
=> 1 })->result;
my
$lsid
= uuid_to_string(
$cursor
->_session->session_id->{id}->data );
my
$cursor_command
=
$events
[-2]->{ command };
my
$cursor_command_sid
= uuid_to_string(
$cursor_command
->{
'lsid'
}->{id}->data );
is
$cursor_command_sid
,
$lsid
,
"Cursor sent with correct lsid"
;
subtest
'All cursor calls in same session'
=>
sub
{
my
@items
=
$cursor
->batch;
while
(
@items
=
$cursor
->batch ) {
my
$command
=
$events
[-2]->{ command };
ok
exists
$command
->{
'lsid'
},
"cursor has session"
;
my
$cursor_session_id
= uuid_to_string(
$command
->{
'lsid'
}->{id}->data );
is
$cursor_session_id
,
$lsid
,
"Cursor is using given session"
;
}
};
undef
$cursor
;
my
$retired_session_id
=
defined
$conn
->_server_session_pool->_server_session_pool->[0]
? uuid_to_string(
$conn
->_server_session_pool->_server_session_pool->[0]->session_id->{id}->data )
:
''
;
is
$retired_session_id
,
$lsid
,
"Session returned to pool at end of cursor lifetime"
;
};
clear_testdbs;
done_testing;