#------------------------------------------------------------------- # # Sub::Contract::Cache - Implement a subroutine's cache # # $Id: Cache.pm,v 1.3 2009/06/16 12:23:58 erwan_lemonnier Exp $ # package Sub::Contract::Cache; use strict; use warnings; use Carp qw(croak confess); use Data::Dumper; use Symbol; our $VERSION = '0.12'; # NOTE: to speed up things, we do very little sanity control of method # arguments, so that a key can for example be undefined though it # should be an error. This class is to be used internally by # Sub::Contract only. If you attempt to use it directly for other # purpose, make sure you really need to do that, and if so, don't rely # on Sub::Contract::Cache to validate them for you. sub new { my ($class,%args) = @_; $class = ref $class || $class; my $size = delete $args{size} or croak "BUG: missing max_size"; my $namespace = delete $args{namespace} or croak "BUG: missing namespace"; croak "BUG: new() got unknown arguments: ".Dumper(%args) if (%args); croak "BUG: size should be a number" if (!defined $size || $size !~ /^\d+$/); # NOTE: $contract->reset() deletes this cache # TODO: do we want to keep previous content of cache? my $self = bless({},$class); $self->{cache} = {}; $self->{cache_max_size} = $size; $self->{cache_size} = 0; $self->{namespace} = $namespace; return $self; } sub clear { my $self = shift; # a fast way to delete all keys in a hash delete @{$self->{cache}}{keys %{$self->{cache}}}; $self->{cache_size} = 0; } sub has { my ($self,$key) = @_; return exists $self->{cache}->{$key}; } sub set { my ($self,$key,$value) = @_; croak "BUG: undefined cache key".Dumper($key,$value) if (!defined $key); if ($self->{cache_size} >= $self->{cache_max_size}) { $self->clear; } $self->{cache}->{$key} = $value; $self->{cache_size}++; } sub get { my ($self,$key) = @_; return $self->{cache}->{$key}; } 1; =pod =head1 NAME Sub::Contract::Cache - A data cache =head1 SYNOPSIS my $cache = new Sub::Contract::Cache(max_size => 10000, namespace => 'foo'); if ($cache->has($key)) { return $cache->get($key); } else { my $value = foo(@args); $cache->set($key,$value); return $value; } =head1 DESCRIPTION A Sub::Contract::Cache is just a data cache used by contracts to memoize subroutine's results. Sub::Contract has its own cache implementation for efficiency reasons. =head1 API =over 4 =item C<< my $cache = new(max_size => $max_size, namespace => $name) >> Return an empty cache object that may contain up to C<$max_size> elements and caches results from the subroutine C<$name>. =item C<< $contract->clear([size => $max_size]) >> Empty this cache of all its elements. =item C<< $contract->set($key,$ref_result) >> Add a cache entry for the key C<$key> with result C<$result>. =item C<< $contract->has($key) >> Return true if the cache contains a result for this key, false if not. =item C<< $contract->get($key) >> Return the cached result associated with key C<$key>. You must call C first to ensure that there really is a cached result for this key. C on an unknown key will return undef and not fail. =back =head1 SEE ALSO See 'Sub::Contract'. =head1 VERSION $Id: Cache.pm,v 1.3 2009/06/16 12:23:58 erwan_lemonnier Exp $ =head1 AUTHOR Erwan Lemonnier C<< >> =head1 LICENSE See Sub::Contract. =cut