Cache::Weak - weak reference cache

Cache-Weak documentation Contained in the Cache-Weak distribution.

Index

Code Index:

NAME

Top

Cache::Weak - weak reference cache

VERSION

Top

This documentation refers to Cache::Weak version 1.0.2

SYNOPSIS

Top

	use Cache::Weak;
	my $cache = Cache::Weak->new();

DESCRIPTION

Top

This cache will store it's objects without increase the reference count. This can be used for caching without interfere in objects DESTROY mechanism, since the reference in this cache won't count.

CONSTRUCTOR

Top

You can pass a number of options to the constructor to specify things like namespace, etc. This is done by passing an inline hash (or hashref):

	my $cache = Cache::Weak->new( namespace => 'foo' );

See "PROPERTIES" below for a list of all available properties that can be set.

METHODS

Top

set
	$cache->set($key, $object);

Store specified key/value pair in cache. Value must be a reference.

get
	my $object = $cache->get($key);

Search cache for given key. Returns undef if not found.

exists
	my $bool = $cache->exists($key);

Returns a boolean value to indicate whether there is any data present in the cache for specified entry.

remove
	$cache->remove($key)

Clear the data for specified entry from the cache.

purge
	$cache->purge();

Weak references are not removed from the cache when last "real" object goes out of scope. This means that over time the cache will grow in memory. purge() will remove all dead references from cache. Usually you don't have to run purge() manually: purging is done automatically. By default, this happens every 1000 object loads, but you can change that default by setting the 'auto_purge_interval' and 'auto_purge' properties.

clear
	$cache->clear();

Removes all entries from cache.

count
	$cache->count();

Returns the number of entries in the cache.

PROPERTIES

Top

namespace
	my $current_ns = $cache->namespace();

The namespace associated with this cache. Defaults to "_" if not explicitly set.

auto_purge_interval
	$cache->auto_purge_interval(5000);

Sets number of cache object loads before auto purging is automatically performed. Default is 1000.

auto_purge
	$cache->auto_purge(0); # turn off auto purge

If this option is true, then the auto purge interval will be checked on every set().

DEPENDENCIES

Top

This module requires weak references support in your system. To find out if your system supports weak references, you can run this on the command line:

	perl -e 'use Scalar::Util qw(weaken)'

If you get an error message about weak references not being implemented, this module would not work.

SEE ALSO

Top

http://github.com/esobchenko/cache-weak/ this module on GitHub.

http://en.wikipedia.org/wiki/Weak_reference about weak references.

Scalar::Util for information about weak references in Perl.

Object::Mapper for an example of this module in use.

LICENSE AND COPYRIGHT

Top

Copyright 2008, Eugen Sobchenko <ejs@cpan.org>

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Cache-Weak documentation Contained in the Cache-Weak distribution. 
#
# $Id: Weak.pm 22 2008-04-22 13:28:19Z esobchenko $
package Cache::Weak;

use strict;
use warnings;

use version; our $VERSION = qv('1.0.3');

use Carp qw/carp croak/;
use Scalar::Util qw/weaken/;

use constant {
	DEFAULT_NAMESPACE => '_',
	DEFAULT_AUTO_PURGE_INTERVAL => 1000,
	DEFAULT_AUTO_PURGE => 1,
};

# data is stored in the form: $cache_data{$namespace}{$key} = $object
my %cache_data = ();
my %cache_meta = ();

# private method: used in constructor to get it's arguments
sub _get_args {
	my $proto = shift;

	my $args;
	if ( scalar(@_) > 1 ) {
		if ( @_ % 2 ) {
			croak "odd number of parameters";
		}
		$args = { @_ };
	} elsif ( ref $_[0] ) {
		unless ( eval { local $SIG{'__DIE__'}; %{ $_[0] } || 1 } ) {
			croak "not a hashref in args";
		}
		$args = $_[0];
	} else {
		$args = { namespace => shift };
	}

	return $args;
}

sub new {
	my $class = shift;
	my $self = $class->_get_args(@_);
	return bless $self, $class;
}

sub namespace {
	my $self = shift;
	if (@_) {
		$self->{namespace} = shift;
	}
	return $self->{namespace} || DEFAULT_NAMESPACE;
}

sub auto_purge_interval {
	my $self = shift;
	if (@_) {
		$self->{auto_purge_interval} = shift;
	}
	return $cache_meta{ $self->namespace }{auto_purge_interval}
		= defined $self->{auto_purge_interval} ?
		$self->{auto_purge_interval} : DEFAULT_AUTO_PURGE_INTERVAL;
}

sub auto_purge {
	my $self = shift;
	if (@_) {
		$self->{auto_purge} = shift;
	}
	return $cache_meta{ $self->namespace }{auto_purge}
		= defined $self->{auto_purge} ?
		$self->{auto_purge} : DEFAULT_AUTO_PURGE;
}

# private method: increment access counter for the given namespace and return it's value
sub _inc_count {
	my $self = shift;
	return $cache_meta{ $self->namespace }{count} += 1;
}

# private method: return actual keys for current namespace
sub _keys {
	my $self = shift;
	return keys %{ $cache_data{ $self->namespace } };
}

sub count {
	my $self = shift;
	return int scalar $self->_keys;
}

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

sub set {
	my ( $self, $key, $object ) = @_;

	croak "attempting to set non-reference value" unless ref $object;

	# is it time to purge cache from dead objects?
	if ( $self->auto_purge ) {
		$self->purge unless ( $self->_inc_count % $self->auto_purge_interval );
	}

	weaken ( $cache_data{ $self->namespace }{$key} = $object );
	return 1;
}

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

# XXX "exists" actually means "defined" in our case
sub exists {
	my ( $self, $key ) = @_;
	return defined $cache_data{ $self->namespace }{$key};
}

sub purge {
	my $self = shift;
	my $cache = $cache_data{ $self->namespace };
	delete @{ $cache }{ grep !$self->exists($_), $self->_keys };
	return 1;
}

sub clear {
	my $self = shift;
	delete $cache_data{ $self->namespace };
	delete $cache_meta{ $self->namespace };
	return 1;
}

1;

__END__