memcached の ネームスペース

職場の自転車部サイクリング大会が雨で中止になって暇なので、兄がPHPで書いたmemacheクラスをperlでリファクタリングした。
memcachedにネームスペース機能を付けると、まとめてデータ削除できたりして便利だよねーって話。

memcachedやAPCは、ネームスペースのような機能をサポートしていない。あるオブジェクトをキャッシュしようと思えば、キーに紐付けて保存することになる訳だが、このままだと、例えば、あるテーブルに対するクエリの結果をキャッシュしようとした場合に、プライマリキーを利用してキーとし、クエリの結果オブジェクトをキャッシュに保存していく、といった使い方になる。ここで問題となるのが、複数のテーブルの行をキャッシュしていった場合に、あるテーブルに対応したキャッシュだけを削除したい場合にどうするのか?という点。キーを指定して保存/取得/削除する事しか出来なければ、複数のアプリケーションから同じmemcachedを使っていた場合等にも、キャッシュの特定の部分を纏めて削除する、といった事が出来ず使い勝手が悪い。

この問題を解決する為に、以下の方法で擬似的にネームスペースを実装してやることが出来る。

http://d.hatena.ne.jp/e-kuroda/20080524

そのままだとあんまり面白くないので、{set,get}_multi相当のメソッドを足した。
引数のvalidationははしょったけど、そこちゃんとやれば割と使えるかも。
テストしして気がついたんだけど、C::M::Fastのflush_allが効かないんですが...なんですかこれ？

package MyMemcache;

use strict;
use warnings;
use feature qw/:5.10/;
use base qw/ Class::Data::Inheritable Class::Accessor::Fast /;
use Carp qw/ croak /;
use Digest::MD5 qw/ md5_hex /;
use Storable qw/ nfreeze /;
use Cache::Memcached::Fast;

__PACKAGE__->mk_classdata( opt => {
    servers      => [ qw/ 127.0.0.1:11211 / ],
    cache_expire => 0,
});

__PACKAGE__->mk_accessors( qw/ memd / );

sub new {
    my ($class, %args) = (shift, (ref $_[0] eq 'HASH')? %{$_[0]} : @_);

    bless {
        memd => Cache::Memcached::Fast->new({
            servers => $class->opt->{servers},
            %args,
        }),
    }, $class;
}

sub save_cache {
    my ($self, $namespace, $key, $value, $expire) = @_;
    my $class = ref $self;

    return $self->memd->set(
        $self->_create_cachekey($namespace, $key),
        $value,
        $expire // $class->opt->{cache_expire},
    );
}

sub save_cache_multi {
    my ($self, $namespace, @items) = @_;
    my $class = ref $self;

    return $self->memd->set_multi(
        map [
            $self->_create_cachekey($namespace, $_->[0]),
            $_->[1],
            $_->[2] // $class->opt->{cache_expire},
        ], @items
    );
}

sub load_cache {
    my ($self, $namespace, $key) = @_;

    return $self->memd->get(
        $self->_create_cachekey($namespace, $key),
    );
}

sub load_cache_multi {
    my ($self, $namespace, @keys) = @_;

    return $self->memd->get_multi(
        map { $self->_create_cachekey($namespace, $_) } @keys
    );
}

sub delete_cache {
    my ($self, $namespace, $key) = @_;

    if (! defined $key) {
        return $self->memd->incr($namespace, 1);
    } else {
        return $self->memd->delete(
            $self->_create_cachekey($namespace, $key)
        );
    }
}

sub flush_cache {
    shift->memd->flush_all;
}

# private //////////////////
sub _create_cachekey {
    my ($self, $namespace, $key) = @_;

    my $namespace_key = $self->memd->get($namespace) // do {
        $self->memd->set($namespace, 0);
        0;
    };

    $key = nfreeze($key) if ref $key;
    return md5_hex(join ":", $namespace, $namespace_key, $key);
}




package main;

my $m = MyMemcache->new();

$m->save_cache('hogeNmaespace', 'fooKey', 'foo');
$m->save_cache('hogeNmaespace', 'barKey', 'bar', 1);
$m->save_cache('fugaNmaespace', 'fooKey', 'foofoo');
sleep 1;
say $m->load_cache('hogeNmaespace', 'fooKey'); # foo
say $m->load_cache('hogeNmaespace', 'barKey'); # undef
say $m->load_cache('fugaNmaespace', 'fooKey'); # foofoo

$m->delete_cache('hogeNmaespace');
say $m->load_cache('hogeNmaespace', 'fooKey'); # undef
say $m->load_cache('hogeNmaespace', 'barKey'); # undef
say $m->load_cache('fugaNmaespace', 'fooKey'); # foofoo

$m->delete_cache('fugaNmaespace');
say $m->load_cache('fugaNmaespace', 'fooKey'); # undef


$m->save_cache_multi('hogeNmaespace', ['fooKey', 'foo'], ['barKey', 'bar']);
say join ',', values %{ $m->load_cache_multi('hogeNmaespace', qw/ fooKey barKey /) };
                                               # foo, bar
$m->save_cache('pet', {lama => 'neko'}, 'x');
say $m->load_cache('pet', {lama => 'neko'});   # x