[Dbix-class] DBIx::Class and memcached

[Oleg Pronin]

Skipped content of type multipart/alternative-------------- next part -----=
---------
package My::ResultSet;
use base qw/DBIx::Class::ResultSet/;
use strict;
use Storable;
use Digest::MD5;

__PACKAGE__->mk_classaccessors(qw/memd/);

sub single {
    my ($self, $where, $attrs) =3D @_;

    if ( my $cache_time =3D $attrs->{memcache} ||
         $self->_resolved_attrs->{memcache}  and
         ( my $memd ||=3D $self->memd )
    )
    {
        my $key =3D 'S-'.getCacheKey([$self->_resolved_attrs, $where, $attr=
s]);
        my $obj;
        return $obj if !$attrs->{expire} and $obj =3D $memd->get($key);
        $obj =3D $self->SUPER::single($where);
        $memd->set($key, $obj, $cache_time);
        return $obj;
    }

    return $self->SUPER::single($where);
}

sub all {
    my $self =3D shift;

    if ( my $cache_time =3D (my $attrs =3D $self->_resolved_attrs)->{memcac=
he} and
         ( my $memd ||=3D $self->memd )
    )
    {
        my $key =3D 'A-'.getCacheKey($attrs);
        my $objs;
        return @$objs if !$attrs->{expire} and $objs =3D $memd->get($key);
        @$objs =3D $self->SUPER::all(@_);
        $memd->set($key, $objs, $cache_time);
        return @$objs;
    }

    return $self->SUPER::all(@_);
}

sub _count {
    my $self =3D shift;

    if ( my $cache_time =3D (my $attrs =3D $self->_resolved_attrs)->{memcac=
he} and
         ( my $memd ||=3D $self->memd )
    )
    {
        my $key =3D 'C-'.getCacheKey($attrs);
        my $count;
        return $count if !$attrs->{expire} && defined ($count =3D $memd->ge=
t($key));
        $count =3D $self->SUPER::_count(@_);
        $memd->set($key, $count, $cache_time);
        return $count;
    }

    return $self->SUPER::_count(@_);
}

sub getCacheKey {
    local $Storable::canonical =3D 1;
    Digest::MD5::md5_hex(Storable::freeze($_[0]));
}

1;