First pass at adding key files
This commit is contained in:
dsainty
245
site/slowtwitch.com/cgi-bin/articles/admin/GT/Cache.pm
Normal file
245
site/slowtwitch.com/cgi-bin/articles/admin/GT/Cache.pm
Normal file
@ -0,0 +1,245 @@
|
||||
# ==================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Cache
|
||||
# Author : Scott Beck
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: Cache.pm,v 1.13 2004/01/13 01:35:15 jagerman Exp $
|
||||
#
|
||||
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ==================================================================
|
||||
#
|
||||
# Description:
|
||||
# Implements a tied hash cache that will not grow forever, but expire
|
||||
# old/unused entries. Useful under mod_perl.
|
||||
#
|
||||
|
||||
package GT::Cache;
|
||||
# ===============================================================
|
||||
use vars qw /$DEBUG $VERSION $CACHE_SIZE/;
|
||||
use strict;
|
||||
|
||||
$DEBUG = 0;
|
||||
$VERSION = sprintf "%d.%03d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/;
|
||||
$CACHE_SIZE = 500;
|
||||
|
||||
##
|
||||
# tie %cache, 'GT::Cache', $size, \&function;
|
||||
# ----------------------------
|
||||
# Is called when you tie a hash to this
|
||||
# class. The size should be the size limit
|
||||
# you want on your hash. If not specified
|
||||
# this will default to the CLASS variable
|
||||
# $CACH_SIZE which is initialized to 500
|
||||
##
|
||||
sub TIEHASH {
|
||||
my $this = shift;
|
||||
my $size = shift || $CACHE_SIZE;
|
||||
my $code = shift || sub {undef};
|
||||
my $class = ref $this || $this;
|
||||
my $self = bless {
|
||||
cache_size => $size,
|
||||
popularity => [],
|
||||
content => {},
|
||||
indices => {},
|
||||
is_indexed => 0,
|
||||
size => 0,
|
||||
code => $code,
|
||||
}, $class;
|
||||
$#{$self->{popularity}} = $size;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub FETCH {
|
||||
my ($self, $key) = @_;
|
||||
if (ref $key) {
|
||||
require GT::Dumper;
|
||||
my $dmp = new GT::Dumper (
|
||||
{
|
||||
data => $key,
|
||||
sort => 1
|
||||
}
|
||||
);
|
||||
my $new = $dmp->dump;
|
||||
$key = $new;
|
||||
}
|
||||
unless (exists $self->{content}->{$key}) {
|
||||
my $val = $self->{code}->($key);
|
||||
defined $val or return undef;
|
||||
$self->STORE ($key, $val);
|
||||
return $val;
|
||||
}
|
||||
if ($self->{is_indexed}) {
|
||||
my ($pos1, $pos2, $replace);
|
||||
|
||||
$pos1 = $self->{content}->{$key}->[1];
|
||||
$pos2 = $pos1 + (int (rand( ($self->{cache_size} - $pos1) / 2) )) || 1;
|
||||
|
||||
$replace = ${$self->{popularity}}[$pos2];
|
||||
|
||||
${$self->{popularity}}[$pos2] = $key;
|
||||
$self->{content}->{$key}->[1] = $pos2;
|
||||
if (defined $replace) {
|
||||
${$self->{popularity}}[$pos1] = $replace;
|
||||
$self->{content}->{$replace}->[1] = $pos1;
|
||||
}
|
||||
}
|
||||
return $self->{content}->{$key}->[0];
|
||||
}
|
||||
|
||||
##
|
||||
# %cash = (key1 => $field1, key2 => $val2);
|
||||
# -----------------------------------------
|
||||
# $cash{key} = $val;
|
||||
# ------------------
|
||||
# Called when you store something in the hash.
|
||||
# This will check the number of elements in the
|
||||
# hash and delete the oldest one if the limit.
|
||||
# is reached.
|
||||
##
|
||||
sub STORE {
|
||||
my ($self, $key, $value) = @_;
|
||||
if (ref $key) {
|
||||
require GT::Dumper;
|
||||
my $dmp = new GT::Dumper (
|
||||
{
|
||||
data => $key,
|
||||
sort => 1
|
||||
}
|
||||
);
|
||||
my $new = $dmp->dump;
|
||||
$key = $new;
|
||||
}
|
||||
my ($replace, $insid);
|
||||
if ($self->{is_indexed}) {
|
||||
$insid = int (rand($self->{cache_size} / 2)) || 1;
|
||||
if (defined ($replace = ${$self->{popularity}}[$insid])) {
|
||||
delete $self->{content}->{$replace};
|
||||
undef ${$self->{popularity}}[$insid];
|
||||
}
|
||||
${$self->{popularity}}[$insid] = $key;
|
||||
$self->{content}->{$key} = [$value, $insid];
|
||||
}
|
||||
else {
|
||||
${$self->{popularity}}[$self->{size}] = $key;
|
||||
$self->{content}->{$key} = [$value, $self->{size}];
|
||||
if ($self->{size} == $self->{cache_size}) {
|
||||
for (0 .. $#{$self->{popularity}}) {
|
||||
next unless defined $self->{popularity}[$_];
|
||||
$self->{content}{$self->{popularity}[$_]}[1] = $_;
|
||||
}
|
||||
$self->{is_indexed} = 1;
|
||||
}
|
||||
$self->{size}++;
|
||||
}
|
||||
}
|
||||
|
||||
sub DELETE {
|
||||
my ($self, $key) = @_;
|
||||
if (ref $key) {
|
||||
require GT::Dumper;
|
||||
my $dmp = new GT::Dumper (
|
||||
{
|
||||
data => $key,
|
||||
sort => 1
|
||||
}
|
||||
);
|
||||
my $new = $dmp->dump;
|
||||
$key = $new;
|
||||
}
|
||||
exists $self->{content}->{$key} or return undef;
|
||||
$self->{size}--;
|
||||
my $aref = delete $self->{content}->{$key};
|
||||
undef $self->{popularity}->[$aref->[1]];
|
||||
return $aref->[0];
|
||||
}
|
||||
|
||||
sub CLEAR {
|
||||
my $self = shift;
|
||||
$self->{content} = {};
|
||||
$self->{size} = 0;
|
||||
$self->{popularity} = [];
|
||||
$self->{is_indexed} = 0;
|
||||
}
|
||||
|
||||
sub EXISTS {
|
||||
my ($self, $key) = @_;
|
||||
if (ref $key) {
|
||||
require GT::Dumper;
|
||||
my $dmp = new GT::Dumper (
|
||||
{
|
||||
data => $key,
|
||||
sort => 1
|
||||
}
|
||||
);
|
||||
my $new = $dmp->dump;
|
||||
$key = $new;
|
||||
}
|
||||
return exists $self->{content}->{$key} ? 1 : 0;
|
||||
}
|
||||
|
||||
sub FIRSTKEY {
|
||||
my $self = shift;
|
||||
my $c = keys %{$self->{content}};
|
||||
return scalar each %{$self->{content}};
|
||||
}
|
||||
|
||||
sub NEXTKEY {return scalar each %{shift()->{content}}}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GT::Cache - Tied hash which caches output of functions.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use GT::Cache;
|
||||
my %cache;
|
||||
tie %cache, 'GT::Cache', $size, \&function;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
GT::Cache implements a simple but quick caching scheme for remembering
|
||||
the results of functions. It also implements a max size to prevent
|
||||
the cache from growing and drops least frequently requested entries
|
||||
first, making it very useful under mod_perl.
|
||||
|
||||
=head1 EXAMPLE
|
||||
|
||||
use GT::Cache;
|
||||
my %cache;
|
||||
tie %cache, 'GT::Cache', 100, \&complex_func;
|
||||
|
||||
while (<>) {
|
||||
print "RESULT: ", $cache{$_}, "\n";
|
||||
}
|
||||
|
||||
sub complex_func {
|
||||
my $input = shift;
|
||||
# .. do complex work.
|
||||
return $output;
|
||||
}
|
||||
|
||||
This will cache the results of complex_func, and only run it when
|
||||
the input is different. It stores a max of 100 entries at a time,
|
||||
with the least frequently requested getting dropped first.
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
Currently, you can only pass as input to the function a single
|
||||
scalar, and the output must be a single scalar. See the
|
||||
Memoize module in CPAN for a much more robust implementation.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
http://www.gossamer-threads.com/
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Revision: $Id: Cache.pm,v 1.13 2004/01/13 01:35:15 jagerman Exp $
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user