4e855eba by Paweł Bogusławski

Memcached cache module for OTRS (IB#1011796)

1 parent 0f77f00d
......@@ -6253,7 +6253,7 @@ via the Preferences button after logging in.
</Setting>
</ConfigItem>
<ConfigItem Name="Cache::SubdirLevels" Required="1" Valid="1" ConfigLevel="200">
<Description Translatable="1">Specify how many sub directory levels to use when creating cache files. This should prevent too many cache files being in one directory.</Description>
<Description Translatable="1">When using FileStorable specify how many sub directory levels to use when creating cache files to prevent too many cache files being in one directory. When using Redis, keys for massive operations will be divided into 16^Cache::SubdirLevels groups to avoid overloading systems with too long key list processing.</Description>
<Group>Framework</Group>
<SubGroup>Core::Cache</SubGroup>
<Setting>
......@@ -6265,6 +6265,27 @@ via the Preferences button after logging in.
</Option>
</Setting>
</ConfigItem>
<ConfigItem Name="Cache::Module::Memcached###Servers" Required="0" Valid="0">
<Description Translatable="1">Defines the memcached servers.</Description>
<Group>Framework</Group>
<SubGroup>Core::Cache</SubGroup>
<Setting>
<Array>
<Item>127.0.0.1:11211</Item>
</Array>
</Setting>
</ConfigItem>
<ConfigItem Name="Cache::Module::Memcached###Parameters" Required="0" Valid="0">
<Description Translatable="1">Defines all the (additional) memcached parameters.</Description>
<Group>Framework</Group>
<SubGroup>Core::Cache</SubGroup>
<Setting>
<Hash>
<Item Key="max_size">10485760</Item>
<Item Key="utf8">1</Item>
</Hash>
</Setting>
</ConfigItem>
<ConfigItem Name="AutoComplete::Agent###Default" Required="0" Valid="1">
<Description Translatable="1">Defines the config options for the autocompletion feature.</Description>
<Group>Framework</Group>
......
# --
# Kernel/System/Cache/Memcached.pm - Memcached module for OTRS cache
# Copyright (C) 2014 Informatyka Boguslawski sp. z o.o. sp.k., http://www.ib.pl/
# Based on:
# http://code.google.com/p/memcached/wiki/NewProgrammingTricks#Namespacing
# FileStorable.pm by OTRS AG, http://otrs.com/
# Memcached.pm by c.a.p.e. IT GmbH, http://www.cape-it.de
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --
package Kernel::System::Cache::Memcached;
use strict;
use warnings;
use Cache::Memcached::Fast;
use Encode;
use Encode::Locale;
use Digest::MD5 qw();
use Time::HiRes qw();
use vars qw(@ISA);
sub new {
my ( $Type, %Param ) = @_;
# allocate new hash for object
my $Self = {};
bless( $Self, $Type );
# check needed objects
for (qw(ConfigObject LogObject MainObject EncodeObject)) {
$Self->{$_} = $Param{$_} || die "Got no $_!";
}
# get memcached connection parameters and open connection to cache
$Self->{Config} = $Self->{ConfigObject}->Get('Cache::Module::Memcached');
if ($Self->{Config} && $Self->{Config}->{Servers} && $Self->{Config}->{Parameters}) {
my $InitParams = {
servers => $Self->{Config}->{Servers},
%{ $Self->{Config}->{Parameters} },
};
$Self->{MemcachedObject} = Cache::Memcached::Fast->new($InitParams);
if (!$Self->{MemcachedObject}) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "Unable to initialize memcached connector: $!",
);
}
}
else {
$Self->{LogObject}->Log(
Priority => 'error',
Message => 'Memcached enabled but no valid Cache::Module::Memcached configuration found!',
);
}
return $Self;
}
sub Set {
my ( $Self, %Param ) = @_;
for (qw(Type Key Value TTL)) {
if ( !defined $Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
return if !$Self->{MemcachedObject};
# get memcached key name for given Type and Key
my $MemcachedKeyName = $Self->_getMemcachedKeyName(
%Param,
InitNamespaceOnError => 1,
);
return if !$MemcachedKeyName;
# Problems occured when using absolute TTLs /time()+$Param{TTL}/ and
# relative TTLs greater than memcached threshold /$Param{TTL}>2592000/
# so we'll limit TTLs to 2592000 (30 days) here. Probably bug in
# Cache::Memcached::Fast. For TTL value details see memcached proto spec
# https://github.com/memcached/memcached/blob/master/doc/protocol.txt
if ( $Param{TTL} > 2592000 ) {
$Param{TTL} = 2592000;
}
return $Self->{MemcachedObject}->set(
$MemcachedKeyName,
$Param{Value},
$Param{TTL}
);
}
sub Get {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(Type Key)) {
if ( !defined $Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
return if !$Self->{MemcachedObject};
# get memcached key name for given Type and Key; do not initialize
# namespace in case of namespace reading error (namespace init after
# simple communication errors would cause same effect as CleanUp
# on this object data type)
my $MemcachedKeyName = $Self->_getMemcachedKeyName(
%Param,
InitNamespaceOnError => 0,
);
return if !$MemcachedKeyName;
return $Self->{MemcachedObject}->get($MemcachedKeyName);
}
sub Delete {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(Type Key)) {
if ( !defined $Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
return if ( !$Self->{MemcachedObject} );
# get memcached key name for given Type and Key
my $MemcachedKeyName = $Self->_getMemcachedKeyName(
%Param,
InitNamespaceOnError => 1,
);
return if !$MemcachedKeyName;
return $Self->{MemcachedObject}->delete($MemcachedKeyName);
}
sub CleanUp {
my ( $Self, %Param ) = @_;
return if !$Self->{MemcachedObject};
# memcached expires data automatically
return 1 if $Param{Expired};
if ( $Param{Type} ) {
# Invalidate namespace in cache by incrementing it; memcached will
# take care of removing invalidated keys (LRU). In case of incrementing
# error try to create new namespace.
if (!$Self->{MemcachedObject}->incr('Namespace:' . $Param{Type}, 1)) {
my $Miliseconds = int(Time::HiRes::gettimeofday() * 1000);
if (!$Self->{MemcachedObject}->add('Namespace:' . $Param{Type}, $Miliseconds)) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "Error deleting objects of type $Param{Type} in memcached!",
);
}
}
return 1;
}
else {
# flush all the cache if no type specified
return $Self->{MemcachedObject}->flush_all();
}
}
=item _getMemcachedKeyName()
Use MD5 digest of Type::Namespace::Key for memcached key (memcached key max
length is 250). Namespace for given cache object type is taken from cache.
New namespace is created if namespace is not found. For this algo idea see
http://code.google.com/p/memcached/wiki/NewProgrammingTricks#Namespacing
We use miliseconds not microseconds because overflow in the "incr" memcached
command wraps around the 64 bit mark.
Returns mamcached key name if determined or nothing on error:
my $PreparedKey = $Self->_getMemcachedKeyName(
Type => 'CacheObjectTypeName',
Key => 'KeyName',
InitNamespaceOnError => 0, # set 1 to initialize namespace if cannot be read
);
=cut
sub _getMemcachedKeyName {
my ( $Self, %Param ) = @_;
# try to find namespace for given key object type
my $MemcachedNamespace = $Self->{MemcachedObject}->get('Namespace:' . $Param{Type});
# if namespace not found - if allowed, create new one using miliseconds since the epoch
if (!$MemcachedNamespace && $Param{InitNamespaceOnError}) {
my $Miliseconds = int(Time::HiRes::gettimeofday() * 1000);
if ($Self->{MemcachedObject}->add('Namespace:' . $Param{Type}, $Miliseconds)) {
# Get namespace from cache in case it was updated meanwhile
$MemcachedNamespace = $Self->{MemcachedObject}->get('Namespace:' . $Param{Type});
}
}
# return nothing if namespace cannot be found
return if !$MemcachedNamespace;
my $MemcachedKeyName = $Param{Type} . ':' . $MemcachedNamespace . ':' . $Param{Key};
$Self->{EncodeObject}->EncodeOutput( \$MemcachedKeyName );
$MemcachedKeyName = Digest::MD5::md5_hex($MemcachedKeyName);
return $MemcachedKeyName;
}
1;
......@@ -2,6 +2,7 @@
# --
# scripts/apache2-perl-startup.pl - to load the modules if mod_perl is used
# Copyright (C) 2001-2014 OTRS AG, http://otrs.com/
# Copyright (C) 2014 Informatyka Boguslawski sp. z o.o. sp.k., http://www.ib.pl/
# --
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU AFFERO General Public License as published by
......@@ -119,6 +120,8 @@ use Kernel::System::Stats;
#use Kernel::System::CustomerUser::LDAP;
#use Kernel::System::CustomerAuth::DB;
#use Kernel::System::CustomerAuth::LDAP;
#use Kernel::System::Cache::FileStorable;
#use Kernel::System::Cache::Memcached;
# web agent middle ware modules
use Kernel::Modules::AgentTicketQueue;
......