view release on metacpan or  search on metacpan

lib/Apache/Session/Store/libmemcached.pm  view on Meta::CPAN

If load balance is enabled it will read from the right cache.

If it fails and failover is enabled, it will try to read
from other pools.

=cut

sub _read_session {
    my ($self, $session) = @_;

    my $args = $session->{args};

    # Select pool
    my ($idx, @alternative_pools) = $self->_select_read_pool($session);

    # Read session and return it if everything is ok
    my $ret = $self->_read_from_pool($session, $idx);
    if (defined($ret) || !$args->{failover} || !@alternative_pools) {
        return $ret;
    }

    # Try other pools if failover is enabled
    for my $pool (@alternative_pools) {
        $ret = $self->_read_from_pool($session, $pool);
        last if (defined($ret));
    }
    return $ret;
}

=head2 _select_read_pool

Private method to select a pool to read from.

We just use 'first session id character' mod $numberOfPools to
select a pool.

Note that we return the first available pool if load balance is
not enabled or if there is only one pool.

=cut
sub _select_read_pool
{
    my ($self, $session) = @_;

    my $args = $session->{args};
    my $sid = $session->{data}->{_session_id};

    my $num_pools = 1;
    my $idx = 0;
    my @alternative_pools;
    if ($sid && length($sid) && $args->{load_balance_pools}) {
        $num_pools = scalar(@{$args->{load_balance_pools}});
        $idx = hex(substr($sid, 0, 1)) % $num_pools;
        @alternative_pools = map { $_ != $idx } 0..($num_pools - 1);
    }
    return ($idx, @alternative_pools);
}

=head2 _update_pools

Private method to return which pools must be updated.

If failover is not enabled only one pool is returned.
Otherwise the designated pool will be returned.

=cut

sub _update_pools
{
    my ($self, $session) = @_;

    my @pools;
    # If failover is enabled remove from available pools,
    # otherwise update designated pool.
    if ($session->{args}->{failover}) {
        @pools = @{$self->{libmemcached}};
    } else {
        my ($idx, @alternative_pools) = $self->_select_read_pool($session);
        return ($self->{libmemcached}->[$idx]);
        @pools = ($self->{libmemcached}->[$idx]);
    }

    return @pools;
}

=head2 _read_from_pool

Private method to read from a given pool.

If read fails it will log the error in case logging is enabled.

=cut
sub _read_from_pool {
    my ($self, $session, $pool) = @_;

    my $instance = $self->{libmemcached}->[$pool]->{instance};
    my $key = $session->{data}->{_session_id};
    my $value = $instance->memcached_get($key);
    my $log = $session->{args}->{log_errors};
    if ($log && !defined($value) && $instance->errstr() ne 'NOT FOUND') {
        my $servers = $self->{libmemcached}->[$pool]->{servers};
        my $errmsg = sprintf(
            'Failed get %s in pool with %s',
            join(' ', @{$servers}),
            $instance->errstr()
        );
        $self->_log_error_message($errmsg);
    }

    return $value;
}

=head2 _write_session

Private method to set a key-value entry in all the configured pools.

=cut

sub _write_session {
    my ($self, $op, $session) = @_;