A singleton wrapper around Cache::Memcached

[skx]

Singleton::Memcache is a perl wrapper around Cache::Memcached. (Which is itself a wrapper around Danga's Memcached providing a fast in-memory cache of arbitary objects.)

This singleton wrapper serves two purposes:

• The cache object is nicely encapsulated, it makes no sense to have a cache object with multiple backend-stores.
• The module will degrade gracefully if the Cache::Memcached module isn't available

Updated: per comments from Tanktalus

# -*- cperl -*- #

=head1 NAME

Singleton::Memcache - A singleton wrapper around Danga's memcache.

=head1 SYNOPSIS

=for example begin

    #!/usr/bin/perl -w

    use Singleton::Memcache;
    use strict;

    my $cache = Singleton::Memcache->instance();

    $cache->set( "bob", "your uncle" );

    $cache->get( "bob" );

    $cache->delete( "bob" );

=for example end


=head1 DESCRIPTION


  Singleton Wrapper around Cache::Memcached

  This is a proxy object, which will attempt to create a Cache::Memcac
+hed
 object to forward requests to.

  If we cannot create one we just use stub implementations to fail
 gracefully.  
  We will fail if the <Cache::Memcached> Perl module isn't available o
+r otherwise 
      fails to connect.


 Steve
 --
 www.steve.org.uk

 $Id: Memcache.pm,v 1.8 2005/11/09 02:30:08 steve Exp $

=cut



package Singleton::Memcache;


use strict;
use warnings;



#
#  The single, global, instance of this object
#
my $_cache;

#
#  The memcache instance we use.
#
my $_memcache;



=head2 new

  Gain access to the cache instance.  If the singleton object has been
 created return it.  Otherwise create a new instance.

=cut

sub instance
{
    $_cache ||= (shift)->new();
}



=head2 new

  Constructor.  We connect to the cache, and store a reference to it
 internally.

  If the cache is disabled in the configuration file then we do nothin
+g,
 similarly if the creation of the cache connection fails then we
 just quietly disable ourself.

=cut

sub new
{
    my ( $self ) = (@_);

    my $class=ref($self) || $self;

    #
    #  See if we're enabled
    #
    my $test    = "use Cache::Memcached;";

    #
    #  Test loading the Cache module, if it fails then
    # the cache isn't enabled.
    #
    eval( $test );
    if ( $@ )
    {
    $enabled = 0;
    }

    #
    # Connect
    #
    if ( $enabled )
    {
    $_memcache = new Cache::Memcached {
        'servers' => [ "localhost:11211" ] };

    }

    return bless {}, $class;
}



=head2 disconnect_all

  Disconnect from the cache

=cut 

sub disconnect_all
{
    my ( $self, @rest ) = ( @_ );

    $_memcache->disconnect_all( @rest ) if defined( $_memcache );
}



=head2 get

  Get a key from the cache

=cut

sub get
{
    my ( $self, @rest ) = ( @_ );

    $_memcache->get( @rest ) if defined( $_memcache );
}



=head2 set

  Set a key in the cache.  Note that we'll get a warning from Perl
 if we attempt to set an undefined value.

  We could catch it here, but we do not.

=cut
sub set
{
    my ( $self, @rest ) = ( @_ );

    $_memcache->set( @rest ) if defined( $_memcache );
}



=head2 delete

  Delete a key from the cache.

=cut

sub delete
{
    my ( $self, @rest ) = ( @_ );


    $_memcache->delete( @rest ) if defined( $_memcache );
}


1;

[Tanktalus]

I'm kinda curious... wouldn't it be easier if your instance() method returned either the real Cache::MemCached object, if that package is available, or a reference to an object of your package if Cache::MemCached is not available? Then you could have an AUTOLOAD that simply did nothing to overload all functions to, well, do nothing, and that would be your degredation.

I'm also curious as to whether you tested this (with warnings/strict) - just looking at it, I'm not sure where the get/set/delete functions are getting their %options hash from. There is a declared %options hash inside new, but it's a lexical which doesn't seem like it should get out from that sub (I'm not seeing this to be a closure).

Finally, I wouldn't change function names in a wrapper: disconnect shouldn't call disconnect_all. It should be called disconnect_all if it calls disconnect_all. That makes the transfer easier.

package Singleton::MemCache;
use strict;
use warnings;

{
my $_cache;
sub instance { $_cache ||= (shift)->new() }
}

sub new
{
   my $class = shift;

   # see if we're enabled.
   eval {
      require Cache::Memcached;
      my $cache = Cache::Memcached->new({
         servers => [ 'localhost:11211' ],
      });
      return $cache;
   };

   # we aren't.
   return bless {}, $class;
}

sub AUTOLOAD { wantarray ? () : undef }

1;

Completely untested, but that's probably closer to what you want. (Note: I did like the instance sub - very nice. I had never thought of doing it that way. Thanks ;-})

It's also faster (because there is one less sub in between the code that's trying to cache stuff and the code that is doing the caching). And we got rid of that evil eval STRING.

(I also got rid of all that nice documentation, but that's because I was just typing this off the top of my head - all your original documentation should continue to hold here, except for that disconnect function - it becomes disconnect_all.)

[skx]

I think in general your approach is probably a better one - especially if there are a significant number of functions that are being proxied. The code you posted seems reasonable to my quick read, and could easily be applied to other wrappers.

However in this particular case I'm actually doing a little bit more in the forwarding-methods (keeping track of cache hits/misses, and verifying that some state is massaged appropriately).

I have updated the code here to work properly under strict + warnings, as you are utterly correct about the broken options hash being invalid.

About your last comment in the method renaming, you are correct. I only changed the names because I'm using a few singletons in my application and every other one uses disconnect - rather than disconnect_all, so it seemed natural to change it to match. On balance leaving its name alone seems best.

++ for the feedback.

[perrin]

See also Class::Singleton.