package MyApp::DBIC::ResultSetMemcached;
use base qw/MyApp::DBIC::ResultSet Class::Accessor::Grouped/;
use strict;
use Storable();
use Digest::SHA1();

__PACKAGE__->mk_group_accessors(inherited => qw/memd/);

sub single {
    my ($self, $where, $attrs) = @_;
    my $res_attrs = $self->_resolved_attrs;

    if ( my $cache_time = $attrs->{cache_for} || $res_attrs->{cache_for}
         and (my $memd = $self->memd)
    )
    {
        my $sub = (delete($attrs->{cache_after}) || delete($res_attrs->{cache_after}));
        my $key = $attrs->{cache_key} || $res_attrs->{cache_key}
                  || ('S-'.getCacheKey([$self->_resolved_attrs, $where, $attrs]));
        my $obj;
        return $obj if !($attrs->{expire} or $res_attrs->{expire}) and $obj = $memd->get($key);
        $obj = $self->SUPER::single($where, $attrs);
        $sub->($obj) if $sub;
        $memd->set($key, $obj, $cache_time);
        return $obj;
    }

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

sub all {
    my $self = shift;

    if ( my $cache_time = (my $attrs = $self->_resolved_attrs)->{cache_for} and
         (my $memd = $self->memd)
    )
    {
        my $sub = delete $attrs->{cache_after};
        my $key = $attrs->{cache_key} || ('A-'.getCacheKey($attrs));
        my $objs;
        return @$objs if !$attrs->{expire} and $objs = $memd->get($key);
        @$objs = $self->SUPER::all(@_);
        map {$sub->($_)} @$objs if $sub;
        $memd->set($key, $objs, $cache_time);
        return @$objs;
    }

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

sub _count {
    my $self = shift;

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

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

sub getCacheKey {
    local $Storable::canonical = 1;
    Digest::SHA1::sha1_hex(Storable::freeze($_[0]));
}

sub cache_for {
    my ($self, $opt) = @_;
    $opt = { 'cache_for' => $opt } unless ref($opt);
    $self->search({}, $opt );
}
*memcache = \&cache_for;

1;