[otrs] OTRS caching module for Redis

[Artis Caune]

Hey guys,

While looking at FileStorable cache issue with our OTRS cluster, I realized
it should not be so hard to write Redis cache backend.

Attached is module to put in Kernel/System/Cache/

- install dependency:
    apt-get install libredis-perl

- Set up Redis server and point to it in Config.pm:
    $Self->{'RedisServer'} = '10.10.10.10:6379';

- Select new backend in Cache::Module SysConfig


Does not make sense for one server, but if you are on NFS makes so much big
difference.

Should be fairly easy to port to Memcache.

Any comments ?


-- 
Artis Caune

    Everything should be made as simple as possible, but not simpler.

package Kernel::System::Cache::RedisStorable;

use strict;
use Digest::MD5 qw(md5_hex);
use Try::Tiny;

use Redis;

use vars qw(@ISA $VERSION);
$VERSION = qw($Revision: 1.0 $) [1];

sub new {
    my ( $Type, %Param ) = @_;

    my $Self = {};
    bless( $Self, $Type );

    # check needed objects
    for (qw(ConfigObject LogObject MainObject EncodeObject)) {
        $Self->{$_} = $Param{$_} || die "Got no $_!";
    }

    if (!$Self->{ConfigObject}->{redis}) {
        my $RedisServer = $Self->{ConfigObject}->Get('RedisServer');
        my $r;
        try {
            $r = Redis->new(server => $RedisServer);
        } catch {
            return $Self;
        };

        $Self->{ConfigObject}->{redis} = $r;
    }

    return $Self;
}

sub Set {
    my ( $Self, %Param ) = @_;

    return if !$Self->{ConfigObject}->{redis};

    # check needed stuff
    for my $Needed (qw(Type Key Value TTL)) {
        if ( !defined $Param{$Needed} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need 
$Needed!" );
            return;
        }
    }

    my $Dump = Storable::nfreeze(
        {
            TTL   => time() + $Param{TTL},
            Value => $Param{Value},
        }
    );

    my $Filename = $Self->{EncodeObject}->EncodeOutput($Param{Key});
    my $Key = $Param{Type} . '/' . md5_hex($Filename);
    my $Value = $Self->{EncodeObject}->EncodeOutput($Dump);

    try {
        $Self->{ConfigObject}->{redis}->set($Key => $Value);
        $Self->{ConfigObject}->{redis}->expire($Key => $Param{TTL});
    } catch {
        undef $Self->{ConfigObject}->{redis};
        return;
    };

    return 1;
}

sub Get {
    my ( $Self, %Param ) = @_;
    my $Content;

    return if !$Self->{ConfigObject}->{redis};

    # check needed stuff
    for my $Needed (qw(Type Key)) {
        if ( !defined $Param{$Needed} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need 
$Needed!" );
            return;
        }
    }

    my $Filename = $Self->{EncodeObject}->EncodeOutput($Param{Key});
    my $Key = $Param{Type} . '/' . md5_hex($Filename);

    try {
        $Content = $Self->{ConfigObject}->{redis}->get($Key);
    } catch {
        undef $Self->{ConfigObject}->{redis};
        return;
    };

    # check if cache exists
    return if !$Content;

    # read data structure back from file dump, use block eval for safety reasons
    my $Storage = eval { Storable::thaw( $Content ) };
    if ( ref $Storage ne 'HASH' ) {
        $Self->Delete(%Param);
        return;
    }
    return $Storage->{Value};
}

sub Delete {
    my ( $Self, %Param ) = @_;

    return if !$Self->{ConfigObject}->{redis};

    # check needed stuff
    for my $Needed (qw(Type Key)) {
        if ( !defined $Param{$Needed} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need 
$Needed!" );
            return;
        }
    }

    my $Filename = $Self->{EncodeObject}->EncodeOutput($Param{Key});
    my $Key = $Param{Type} . '/' . md5_hex($Filename);

    try {
        $Self->{ConfigObject}->{redis}->del($Key);
    } catch {
        undef $Self->{ConfigObject}->{redis};
        return;
    };

    return 1;
}

sub CleanUp {
    my ( $Self, %Param ) = @_;

    return if !$Self->{ConfigObject}->{redis};

    if ( $Param{Expired} ) {
        return 1;
    }

    if ( !$Param{Type} ) {
        try {
            $Self->{ConfigObject}->{redis}->flushdb();
        } catch {
            undef $Self->{ConfigObject}->{redis};
            return;
        };
        return 1;
    }

    my @keys;
    try {
        @keys = $Self->{ConfigObject}->{redis}->keys( $Param{Type} . '/*' );
        foreach (@keys) {
            $Self->{ConfigObject}->{redis}->del($_);
        }
    } catch {
        undef $Self->{ConfigObject}->{redis};
        return;
    };

    return 1;
}

1;

---------------------------------------------------------------------
OTRS mailing list: otrs - Webpage: http://otrs.org/
Archive: http://lists.otrs.org/pipermail/otrs
To unsubscribe: http://lists.otrs.org/cgi-bin/listinfo/otrs