DBI::Util::CacheMemory - a very fast but very minimal subset of Cache::Memory

DBI documentation Contained in the DBI distribution.

Index

Code Index:

NAME

Top

DBI::Util::CacheMemory - a very fast but very minimal subset of Cache::Memory

DESCRIPTION

Top

Like Cache::Memory (part of the Cache distribution) but doesn't support any fancy features.

This module aims to be a very fast compatible strict sub-set for simple cases, such as basic client-side caching for DBD::Gofer.

Like Cache::Memory, and other caches in the Cache and Cache::Cache distributions, the data will remain in the cache until cleared, it expires, or the process dies. The cache object simply going out of scope will not destroy the data.

METHODS WITH CHANGES

Top

new

All options except namespace are ignored.

set

Doesn't support expiry.

purge

Same as clear() - deletes everything in the namespace.

METHODS WITHOUT CHANGES

Top

clear
count
exists
remove

UNSUPPORTED METHODS

Top

If it's not listed above, it's not supported.

DBI documentation Contained in the DBI distribution. 
package DBI::Util::CacheMemory;

#   $Id: CacheMemory.pm 10314 2007-11-26 22:25:33Z timbo $
#
#   Copyright (c) 2007, Tim Bunce, Ireland
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.

use strict;
use warnings;


our $VERSION = sprintf("0.%06d", q$Revision: 10314 $ =~ /(\d+)/o);

my %cache;

sub new {
    my ($class, %options ) = @_;
    my $namespace = $options{namespace} ||= 'Default';
    #$options{_cache} = \%cache; # can be handy for debugging/dumping
    my $self =  bless \%options => $class;
    $cache{ $namespace } ||= {}; # init - ensure it exists
    return $self;
}

sub set {
    my ($self, $key, $value) = @_;
    $cache{ $self->{namespace} }->{$key} = $value;
}

sub get {
    my ($self, $key) = @_;
    return $cache{ $self->{namespace} }->{$key};
}

sub exists {
    my ($self, $key) = @_;
    return exists $cache{ $self->{namespace} }->{$key};
}

sub remove {
    my ($self, $key) = @_;
    return delete $cache{ $self->{namespace} }->{$key};
}

sub purge {
    return shift->clear;
}

sub clear {
    $cache{ shift->{namespace} } = {};
}

sub count {
    return scalar keys %{ $cache{ shift->{namespace} } };
}

sub size {
    my $c = $cache{ shift->{namespace} };
    my $size = 0;
    while ( my ($k,$v) = each %$c ) {
        $size += length($k) + length($v);
    }
    return $size;
}

1;