home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.f-secure.com
/
2014.06.ftp.f-secure.com.tar
/
ftp.f-secure.com
/
support
/
hotfix
/
fsis
/
IS-SpamControl.fsfix
/
iufssc
/
lib
/
FS
/
Cache.pm
next >
Wrap
Text File
|
2006-11-29
|
3KB
|
147 lines
package FS::Cache;
use strict;
use warnings;
use Time::HiRes qw(time);
# TODO: for debugging only
use Mail::SpamAssassin::Logger;
sub new {
my ($this, $max_size, $ttl) = @_;
my $class = ref($this) || $this;
my $self = {
max_size => $max_size > 1 ? $max_size : 1,
ttl => $ttl,
count => 0,
hits => 0,
misses => 0,
hash => {},
list => [],
};
$self->{prev} = $self;
$self->{next} = $self;
bless $self, $class;
dbg("cache: created cache with max_size = $self->{max_size}, ttl = $self->{ttl}");
return $self;
}
sub _rem {
my ($self, $node) = @_;
# sanity check
die unless $node->{prev} && $node->{next};
my $prev = $node->{prev};
my $next = $node->{next};
# sanity check
die unless $prev->{next} eq $node;
die unless $next->{prev} eq $node;
$prev->{next} = $next;
$next->{prev} = $prev;
$node->{prev} = undef;
$node->{next} = undef;
my $n = delete $self->{hash}->{$node->{key}};
# sanity check
die unless $n eq $node;
$self->{count}--;
}
sub _prepend {
my ($self, $node) = @_;
my $first = $self->{next};
$self->{next} = $node;
$node->{next} = $first;
$first->{prev} = $node;
$node->{prev} = $self;
$self->{hash}->{$node->{key}} = $node;
++$self->{count};
while ($self->{count} > $self->{max_size}) {
$self->_rem($self->{prev});
}
}
sub _get {
my ($self, $key) = @_;
my $h = $self->{hash};
return undef unless exists $$h{$key};
my $node = $$h{$key};
# take the node off from its current position
$self->_rem($node);
# is it stale?
dbg("cache: expired $key") if time() >= $node->{expiry};
return undef if time() >= $node->{expiry};
# move node first in the LRU list
$self->_prepend($node);
return $node;
}
sub get {
my ($self, $key) = @_;
my $node = $self->_get($key);
if ($node) {
$self->{hits}++;
dbg("cache: hit: " . $self->{hits} . " " . $key);
return $node->{value};
}
$self->{misses}++;
dbg("cache: miss: " . $self->{misses} . " " . $key);
return undef;
}
sub set {
my ($self, $key, $value, $ttl) = @_;
$ttl ||= $self->{ttl};
my $node = $self->_get($key);
return if defined $node;
dbg("cache: adding key $key for $ttl secs, " . $self->{count} . " items");
$node = {
key => $key,
value => $value,
expiry => time() + $ttl,
prev => undef,
next => undef
};
$self->_prepend($node);
}
sub remove {
my ($self, $key) = @_;
my $node = $self->_get($key);
return unless defined $node;
$self->_rem($node);
}
sub stats {
my ($self) = @_;
return ($self->{hits}, $self->{misses});
}
1;