SimpleDB::Class::Cache - Memcached interface for SimpleDB.

SimpleDB-Class documentation Contained in the SimpleDB-Class distribution.

Index

Code Index:

NAME

Top

SimpleDB::Class::Cache - Memcached interface for SimpleDB.

VERSION

Top

version 1.0502

DESCRIPTION

Top

An API that allows you to cache item data to a memcached server. Technically I should be storing the item itself, but since the item has a reference to the domain, and the domain has a reference to the simpledb object, it could cause all sorts of problems, so it's just safer to store just the item's data.

SYNOPSIS

Top

 use SimpleDB::Class::Cache;

 my $cache = SimpleDB::Class::Cache->new(servers=>[{host=>'127.0.0.1', port=>11211}]);

 $cache->set($domain->name, $id, $value);

 my $value = $cache->get($domain->name, $id);
 my ($val1, $val2) = @{$cache->mget([[$domain->name, $id1], [$domain->name, $id2]])};

 $cache->delete($domain->name, $id);

 $cache->flush;

METHODS

Top

These methods are available from this class:

new ( params )

Constructor.

params

A hash containing configuration params to connect to memcached.

servers

An array reference of servers (sockets and/or hosts). It should look similar to:

 [
    { host => '127.0.0.1', port=> '11211' },
    { socket  => '/path/to/unix/socket' },
 ]

servers ( )

Returns the array reference of servers passed into the constructor.

memcached ( )

Returns a Memcached::libmemcached object, which is constructed using the information passed into the constructor.

fix_key ( domain, id )

Returns a key after it's been processed for completeness. Merges a domain name and a key name with a colon. Keys cannot have any spaces in them, and this fixes that. However, it means that "foo bar" and "foo_bar" are the same thing.

domain

They domain name to process.

id

They id name to process.

delete ( domain, id )

Delete a key from the cache.

Throws SimpleDB::Class::Exception::InvalidParam, SimpleDB::Class::Exception::Connection and SimpleDB::Class::Exception.

domain

The domain name to delete from.

id

The key to delete.

flush ( )

Empties the caching system.

Throws SimpleDB::Class::Exception::Connection and SimpleDB::Class::Exception.

get ( domain, id )

Retrieves a key value from the cache.

Throws SimpleDB::Class::Exception::InvalidObject, SimpleDB::Class::Exception::InvalidParam, SimpleDB::Class::Exception::ObjectNotFound, SimpleDB::Class::Exception::Connection and SimpleDB::Class::Exception.

domain

The domain name to retrieve from.

id

The key to retrieve.

mget ( keys )

Retrieves multiple values from cache at once, which is much faster than retrieving one at a time. Returns an array reference containing the values in the order they were requested.

Throws SimpleDB::Class::Exception::InvalidParam, SimpleDB::Class::Exception::Connection and SimpleDB::Class::Exception.

keys

An array reference of domain names and ids to retrieve.

set ( domain, id, value [, ttl] )

Sets a key value to the cache.

Throws SimpleDB::Class::Exception::InvalidParam, SimpleDB::Class::Exception::Connection, and SimpleDB::Class::Exception.

domain

The name of the domain to set the info into.

id

The name of the key to set.

value

A hash reference to store.

ttl

A time in seconds for the cache to exist. Default is 3600 seconds (1 hour).

EXCEPTIONS

Top

This class throws a lot of inconvenient, but useful exceptions. If you just want to avoid them you could:

 my $value = eval { $cache->get($key) };
 if (SimpleDB::Class::Exception::ObjectNotFound->caught) {
    $value = $db->fetchValueFromTheDatabase;
 }

The exceptions that can be thrown are:

SimpleDB::Class::Exception

When an uknown exception happens, or there are no configured memcahed servers in the cacheServers directive in your config file.

SimpleDB::Class::Exception::Connection

When it can't connect to the memcached servers that are configured.

SimpleDB::Class::Exception::InvalidParam

When you pass in the wrong arguments.

SimpleDB::Class::Exception::ObjectNotFound

When you request a cache key that doesn't exist on any configured memcached server.

SimpleDB::Class::Exception::InvalidObject

When an object can't be thawed from cache due to corruption of some sort.

LEGAL

Top

SimpleDB::Class is Copyright 2009-2010 Plain Black Corporation (http://www.plainblack.com/) and is licensed under the same terms as Perl itself.

SimpleDB-Class documentation Contained in the SimpleDB-Class distribution. 
package SimpleDB::Class::Cache;
BEGIN {
  $SimpleDB::Class::Cache::VERSION = '1.0502';
}



use Moose;
use SimpleDB::Class::Exception;
use Memcached::libmemcached;
use Storable ();
use Params::Validate qw(:all);
Params::Validate::validation_options( on_fail => sub { 
        my $error = shift; 
        warn "Error in Cache params: ".$error; 
        SimpleDB::Class::Exception::InvalidParam->throw( error => $error );
        } );




#-------------------------------------------------------------------


#-------------------------------------------------------------------


has 'servers' => (
    is          => 'ro',
    required    => 1,
);

#-------------------------------------------------------------------


has 'memcached' => (
    is  => 'ro',
    lazy    => 1,
    clearer => 'clear_memcached',
    default => sub {
        my $self = shift;
        my $memcached = Memcached::libmemcached::memcached_create();
        foreach my $server (@{$self->servers}) {
            if (exists $server->{socket}) {
                Memcached::libmemcached::memcached_server_add_unix_socket($memcached, $server->{socket}); 
            }
            else {
                Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port});
            }
        }
        return $memcached;
    },
);


#-------------------------------------------------------------------


sub fix_key {
    my ($self, $domain, $id) = @_;
    my $key = $domain.":".$id;
    $key =~ s/\s+/_/g;
    return $key;
}

#-------------------------------------------------------------------


sub delete {
    my $self = shift;
    my ($domain, $id, $retry) = validate_pos(@_, { type => SCALAR }, { type => SCALAR }, { optional => 1 } );
    my $key = $self->fix_key($domain, $id);
    my $memcached = $self->memcached;
    Memcached::libmemcached::memcached_delete($memcached, $key);
    if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
            );
    }
    elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) {
        if ($retry) {
            SimpleDB::Class::Exception::Connection->throw(
                error   => "Cannot connect to memcached server."
            );
        }
        else {
            warn "Memcached went away, reconnecting.";
            $self->clear_memcached;
            $self->delete($domain, $id, 1);
        }
    }
    elsif ($memcached->errstr eq 'NOT FOUND' ) {
       SimpleDB::Class::Exception::ObjectNotFound->throw(
            error   => "The cache key $key has no value.",
            id      => $key,
            );
    }
    elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
       SimpleDB::Class::Exception->throw(
            error   => "No memcached servers specified."
            );
    }
    elsif ($memcached->errstr ne 'SUCCESS' # deleted
        && $memcached->errstr ne 'PROTOCOL ERROR' # doesn't exist to delete
        ) {
        SimpleDB::Class::Exception->throw(
            error   => "Couldn't delete $key from cache because ".$memcached->errstr
            );
    }
}

#-------------------------------------------------------------------


sub flush {
    my ($self, $retry) = @_;
    my $memcached = $self->memcached;
    Memcached::libmemcached::memcached_flush($memcached);
    if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
        );
    }
    elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
        ) if $retry;

        warn "Memcached went away, reconnecting.";
        $self->clear_memcached;
        return $self->flush(1);
    }
    elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
        SimpleDB::Class::Exception->throw(
            error   => "No memcached servers specified."
        );
    }
    elsif ($memcached->errstr ne 'SUCCESS') {
        SimpleDB::Class::Exception->throw(
            error   => "Couldn't flush cache because ".$memcached->errstr
        );
    }
}

#-------------------------------------------------------------------


sub get {
    my $self = shift;
    my ($domain, $id, $retry) = validate_pos(@_, { type => SCALAR }, { type => SCALAR }, { optional => 1 });
    my $key = $self->fix_key($domain, $id);
    my $memcached = $self->memcached;
    my $content = Memcached::libmemcached::memcached_get($memcached, $key);
    $content = Storable::thaw($content);
    if ($memcached->errstr eq 'SUCCESS') {
        if (ref $content) {
            return $content;
        }
        else {
            SimpleDB::Class::Exception::InvalidObject->throw(
                error   => "Couldn't thaw value for $key."
                );
        }
    }
    elsif ($memcached->errstr eq 'NOT FOUND' ) {
        SimpleDB::Class::Exception::ObjectNotFound->throw(
            error   => "The cache key $key has no value.",
            id      => $key,
            );
    }
    elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
        SimpleDB::Class::Exception->throw(
            error   => "No memcached servers specified."
            );
    }
    elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0' || $retry) {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
            );
    }
    elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) {
        warn "Memcached went away, reconnecting.";
        $self->clear_memcached;
        return $self->get($domain, $id, 1);
    }
    SimpleDB::Class::Exception->throw(
        error   => "Couldn't get $key from cache because ".$memcached->errstr
    );
}

#-------------------------------------------------------------------


sub mget {
    my $self = shift;
    my ($names) = validate_pos(@_, { type => ARRAYREF });
    my $retry = shift;
    my @keys = map { $self->fix_key(@{$_}) } @{ $names };
    my %result;
    my $memcached = $self->memcached;
    $memcached->mget_into_hashref(\@keys, \%result);
    if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
            );
    }
    elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
            ) if $retry;
        warn "Memcached went away, reconnecting.";
        $self->clear_memcached;
        return $self->get($names, 1);
    }
    elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
        SimpleDB::Class::Exception->throw(
            error   => "No memcached servers specified."
            );
    }
    # no other useful status messages are returned
    my @values;
    foreach my $key (@keys) {
        my $content = Storable::thaw($result{$key});
        unless (ref $content) {
            SimpleDB::Class::Exception::InvalidObject->throw(
                id      => $key,
                error   => "Can't thaw object returned from memcache for $key.",
                );
            next;
        }
        push @values, $content;
    }
    return \@values;
}

#-------------------------------------------------------------------


sub set {
    my $self = shift;
    my ($domain, $id, $value, $ttl, $retry) = validate_pos(@_, { type => SCALAR }, { type => SCALAR }, { type => HASHREF }, { type => SCALAR | UNDEF, optional => 1 }, { optional => 1 });
    my $key = $self->fix_key($domain, $id);
    $ttl ||= 60;
    my $frozenValue = Storable::nfreeze($value); 
    my $memcached = $self->memcached;
    Memcached::libmemcached::memcached_set($memcached, $key, $frozenValue, $ttl);
    if ($memcached->errstr eq 'SUCCESS') {
        return $value;
    }
    elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0' || $retry) {
        SimpleDB::Class::Exception::Connection->throw(
            error   => "Cannot connect to memcached server."
            );
    }
    elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) {
        warn "Memcached went away, reconnecting.";
        $self->clear_memcached;
        return $self->set($domain, $id, $value, $ttl, 1);
    }
    elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
        SimpleDB::Class::Exception->throw(
            error   => "No memcached servers specified."
            );
    }
    SimpleDB::Class::Exception->throw(
        error   => "Couldn't set $key to cache because ".$memcached->errstr
        );
    return $value;
}




no Moose;
__PACKAGE__->meta->make_immutable;