# -*- 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::Memcached
 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 or 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 nothing,
 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;