Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
BSON	[ DIR ]	drwxr-xr-x
GridFSBucket	[ DIR ]	drwxr-xr-x
Op	[ DIR ]	drwxr-xr-x
QueryResult	[ DIR ]	drwxr-xr-x
Role	[ DIR ]	drwxr-xr-x
Upgrading	[ DIR ]	drwxr-xr-x
BulkWrite.pm	13.6 KB	-rw-r--r--
BulkWriteResult.pm	13.99 KB	-rw-r--r--
BulkWriteView.pm	8.19 KB	-rw-r--r--
ChangeStream.pm	10.71 KB	-rw-r--r--
ClientSession.pm	33.85 KB	-rw-r--r--
Code.pm	1.56 KB	-rw-r--r--
Collection.pm	105.71 KB	-rw-r--r--
CommandResult.pm	5.14 KB	-rw-r--r--
Cursor.pm	26.08 KB	-rw-r--r--
DBRef.pm	1.59 KB	-rw-r--r--
DataTypes.pod	12.78 KB	-rw-r--r--
Database.pm	28.5 KB	-rw-r--r--
DeleteResult.pm	2.41 KB	-rw-r--r--
Error.pm	18.86 KB	-rw-r--r--
Examples.pod	14.35 KB	-rw-r--r--
GridFSBucket.pm	27.45 KB	-rw-r--r--
IndexView.pm	19.83 KB	-rw-r--r--
InsertManyResult.pm	3.41 KB	-rw-r--r--
InsertOneResult.pm	2.32 KB	-rw-r--r--
MongoClient.pm	97.69 KB	-rw-r--r--
Monitoring.pod	7.29 KB	-rw-r--r--
OID.pm	2.17 KB	-rw-r--r--
QueryResult.pm	11.24 KB	-rw-r--r--
ReadConcern.pm	3.87 KB	-rw-r--r--
ReadPreference.pm	8.54 KB	-rw-r--r--
Timestamp.pm	1.6 KB	-rw-r--r--
Tutorial.pod	9.18 KB	-rw-r--r--
UnacknowledgedResult.pm	1.98 KB	-rw-r--r--
UpdateResult.pm	3.54 KB	-rw-r--r--
Upgrading.pod	12.18 KB	-rw-r--r--
WriteConcern.pm	5.05 KB	-rw-r--r--
_Constants.pm	2.87 KB	-rw-r--r--
_Credential.pm	13.58 KB	-rw-r--r--
_Dispatcher.pm	11.87 KB	-rw-r--r--
_Link.pm	18.18 KB	-rw-r--r--
_Platform.pm	897 B	-rw-r--r--
_Protocol.pm	23.46 KB	-rw-r--r--
_Server.pm	8.31 KB	-rw-r--r--
_ServerSession.pm	3.41 KB	-rw-r--r--
_SessionPool.pm	3.86 KB	-rw-r--r--
_Topology.pm	46.27 KB	-rw-r--r--
_TransactionOptions.pm	3.72 KB	-rw-r--r--
_Types.pm	7.11 KB	-rw-r--r--
_URI.pm	19.46 KB	-rw-r--r--

Code Editor : _SessionPool.pm

#  Copyright 2018 - present MongoDB, Inc.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#  http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

use strict;
use warnings;
package MongoDB::_SessionPool;

use version;
our $VERSION = 'v2.2.2';

use Moo;
use MongoDB::_ServerSession;
use Types::Standard qw(
    ArrayRef
    InstanceOf
);

has dispatcher => (
    is => 'ro',
    required => 1,
    isa => InstanceOf['MongoDB::_Dispatcher'],
);

has topology=> (
    is => 'ro',
    required => 1,
    isa => InstanceOf['MongoDB::_Topology'],
);

has _server_session_pool => (
    is => 'lazy',
    isa => ArrayRef[InstanceOf['MongoDB::_ServerSession']],
    init_arg => undef,
    clearer => 1,
    builder => sub { [] },
);

has _pool_epoch => (
    is => 'rwp',
    init_arg => undef,
    default => 0,
);

# Returns a L<MongoDB::ServerSession> that was at least one minute remaining
# before session times out. Returns undef if no sessions available.
#
# Also retires any expiring sessions from the front of the queue as requried.

sub get_server_session {
    my ( $self ) = @_;

if ( scalar( @{ $self->_server_session_pool } ) > 0 ) {
        my $session_timeout = $self->topology->logical_session_timeout_minutes;
        # if undefined, sessions not actually supported so drop out here
        while ( my $session = shift @{ $self->_server_session_pool } ) {
            next if $session->_is_expiring( $session_timeout );
            return $session;
        }
    }
    return MongoDB::_ServerSession->new( pool_epoch => $self->_pool_epoch );
}

# Place a session back into the pool for use. Will check that there is at least
# one minute remaining in the session, and if so will place the session at the
# front of the pool.
#
# Also checks for expiring sessions at the back of the pool, and retires as
# required.

sub retire_server_session {
    my ( $self, $server_session ) = @_;

return if $server_session->pool_epoch != $self->_pool_epoch;

my $session_timeout = $self->topology->logical_session_timeout_minutes;

# Expire old sessions from back of queue
    while ( my $session = $self->_server_session_pool->[-1] ) {
        last unless $session->_is_expiring( $session_timeout );
        pop @{ $self->_server_session_pool };
    }

unless ( $server_session->_is_expiring( $session_timeout ) ) {
        unshift @{ $self->_server_session_pool }, $server_session
            unless $server_session->dirty;
    }
    return;
}

# Close all sessions registered with the server. Used during global cleanup.

sub end_all_sessions {
    my ( $self ) = @_;

my @batches;
    push @batches,
        [ splice @{ $self->_server_session_pool }, 0, 10_000 ]
            while @{ $self->_server_session_pool };

for my $batch ( @batches ) {
        my $sessions = [
            map { defined $_ ? $_->session_id : () } @$batch
        ];
        # Ignore any errors generated from this
        eval {
            $self->dispatcher->send_admin_command([
                endSessions => $sessions,
            ], 'primaryPreferred');
        };
    }
}

# When reconnecting a client after a fork, we need to clear the pool
# without ending sessions with the server and increment the pool epoch
# so existing sessions aren't checked back in.
sub reset_pool {
    my ( $self ) = @_;
    $self->_clear_server_session_pool;
    $self->_set__pool_epoch( $self->_pool_epoch + 1 );
}

sub DEMOLISH {
    my ( $self, $in_global_destruction ) = @_;

$self->end_all_sessions;
}

${this.title}

Code Editor : _SessionPool.pm