File Coverage

blib/lib/MongoDB/_SessionPool.pm
Criterion Covered Total %
statement 18 54 33.3
branch 0 14 0.0
condition n/a
subroutine 6 12 50.0
pod 0 5 0.0
total 24 85 28.2


line stmt bran cond sub pod time code
1             # Copyright 2018 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 58     58   426 use strict;
  58         139  
  58         1853  
16 58     58   314 use warnings;
  58         127  
  58         2029  
17             package MongoDB::_SessionPool;
18              
19 58     58   331 use version;
  58         172  
  58         346  
20             our $VERSION = 'v2.2.0';
21              
22 58     58   4693 use Moo;
  58         142  
  58         360  
23 58     58   42173 use MongoDB::_ServerSession;
  58         180  
  58         2250  
24 58         314 use Types::Standard qw(
25             ArrayRef
26             InstanceOf
27 58     58   466 );
  58         133  
28              
29             has dispatcher => (
30             is => 'ro',
31             required => 1,
32             isa => InstanceOf['MongoDB::_Dispatcher'],
33             );
34              
35             has topology=> (
36             is => 'ro',
37             required => 1,
38             isa => InstanceOf['MongoDB::_Topology'],
39             );
40              
41             has _server_session_pool => (
42             is => 'lazy',
43             isa => ArrayRef[InstanceOf['MongoDB::_ServerSession']],
44             init_arg => undef,
45             clearer => 1,
46 0     0     builder => sub { [] },
47             );
48              
49             has _pool_epoch => (
50             is => 'rwp',
51             init_arg => undef,
52             default => 0,
53             );
54              
55             # Returns a L that was at least one minute remaining
56             # before session times out. Returns undef if no sessions available.
57             #
58             # Also retires any expiring sessions from the front of the queue as requried.
59              
60             sub get_server_session {
61 0     0 0   my ( $self ) = @_;
62              
63 0 0         if ( scalar( @{ $self->_server_session_pool } ) > 0 ) {
  0            
64 0           my $session_timeout = $self->topology->logical_session_timeout_minutes;
65             # if undefined, sessions not actually supported so drop out here
66 0           while ( my $session = shift @{ $self->_server_session_pool } ) {
  0            
67 0 0         next if $session->_is_expiring( $session_timeout );
68 0           return $session;
69             }
70             }
71 0           return MongoDB::_ServerSession->new( pool_epoch => $self->_pool_epoch );
72             }
73              
74             # Place a session back into the pool for use. Will check that there is at least
75             # one minute remaining in the session, and if so will place the session at the
76             # front of the pool.
77             #
78             # Also checks for expiring sessions at the back of the pool, and retires as
79             # required.
80              
81             sub retire_server_session {
82 0     0 0   my ( $self, $server_session ) = @_;
83              
84 0 0         return if $server_session->pool_epoch != $self->_pool_epoch;
85              
86 0           my $session_timeout = $self->topology->logical_session_timeout_minutes;
87              
88             # Expire old sessions from back of queue
89 0           while ( my $session = $self->_server_session_pool->[-1] ) {
90 0 0         last unless $session->_is_expiring( $session_timeout );
91 0           pop @{ $self->_server_session_pool };
  0            
92             }
93              
94 0 0         unless ( $server_session->_is_expiring( $session_timeout ) ) {
95 0 0         unshift @{ $self->_server_session_pool }, $server_session
  0            
96             unless $server_session->dirty;
97             }
98 0           return;
99             }
100              
101             # Close all sessions registered with the server. Used during global cleanup.
102              
103             sub end_all_sessions {
104 0     0 0   my ( $self ) = @_;
105              
106 0           my @batches;
107             push @batches,
108 0           [ splice @{ $self->_server_session_pool }, 0, 10_000 ]
109 0           while @{ $self->_server_session_pool };
  0            
110              
111 0           for my $batch ( @batches ) {
112             my $sessions = [
113 0 0         map { defined $_ ? $_->session_id : () } @$batch
  0            
114             ];
115             # Ignore any errors generated from this
116 0           eval {
117 0           $self->dispatcher->send_admin_command([
118             endSessions => $sessions,
119             ], 'primaryPreferred');
120             };
121             }
122             }
123              
124             # When reconnecting a client after a fork, we need to clear the pool
125             # without ending sessions with the server and increment the pool epoch
126             # so existing sessions aren't checked back in.
127             sub reset_pool {
128 0     0 0   my ( $self ) = @_;
129 0           $self->_clear_server_session_pool;
130 0           $self->_set__pool_epoch( $self->_pool_epoch + 1 );
131             }
132              
133             sub DEMOLISH {
134 0     0 0   my ( $self, $in_global_destruction ) = @_;
135              
136 0           $self->end_all_sessions;
137             }
138              
139             1;