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 >
Text File  |  2006-11-29  |  3KB  |  147 lines
  1. package FS::Cache;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use Time::HiRes qw(time);
  7.  
  8. # TODO: for debugging only
  9. use Mail::SpamAssassin::Logger;
  10.  
  11. sub new {
  12.     my ($this, $max_size, $ttl) = @_;
  13.     my $class = ref($this) || $this;
  14.     my $self = {
  15.         max_size => $max_size > 1 ? $max_size : 1,
  16.         ttl => $ttl,
  17.         count => 0,
  18.         hits => 0,
  19.         misses => 0,
  20.         hash => {},
  21.         list => [],
  22.     };
  23.     $self->{prev} = $self;
  24.     $self->{next} = $self;
  25.     bless $self, $class;
  26.  
  27.     dbg("cache: created cache with max_size = $self->{max_size}, ttl = $self->{ttl}");
  28.     return $self;
  29. }
  30.  
  31. sub _rem {
  32.     my ($self, $node) = @_;
  33.  
  34.     # sanity check
  35.     die unless $node->{prev} && $node->{next};
  36.  
  37.     my $prev = $node->{prev};
  38.     my $next = $node->{next};
  39.  
  40.     # sanity check
  41.     die unless $prev->{next} eq $node;
  42.     die unless $next->{prev} eq $node;
  43.  
  44.     $prev->{next} = $next;
  45.     $next->{prev} = $prev;
  46.  
  47.     $node->{prev} = undef;
  48.     $node->{next} = undef;
  49.  
  50.     my $n = delete $self->{hash}->{$node->{key}};
  51.  
  52.     # sanity check
  53.     die unless $n eq $node;
  54.  
  55.     $self->{count}--;
  56. }
  57.  
  58. sub _prepend {
  59.     my ($self, $node) = @_;
  60.     
  61.     my $first = $self->{next};
  62.     
  63.     $self->{next} = $node;
  64.     $node->{next} = $first;
  65.  
  66.     $first->{prev} = $node;
  67.     $node->{prev} = $self;
  68.     
  69.     $self->{hash}->{$node->{key}} = $node;
  70.     ++$self->{count};
  71.  
  72.     while ($self->{count} > $self->{max_size}) {
  73.         $self->_rem($self->{prev});
  74.     }
  75. }
  76.  
  77. sub _get {
  78.     my ($self, $key) = @_;
  79.  
  80.     my $h = $self->{hash};
  81.     return undef unless exists $$h{$key};
  82.  
  83.     my $node = $$h{$key};
  84.  
  85.     # take the node off from its current position
  86.     $self->_rem($node);
  87.  
  88.     # is it stale?
  89.     dbg("cache: expired $key") if time() >= $node->{expiry};
  90.     return undef if time() >= $node->{expiry};
  91.  
  92.     # move node first in the LRU list
  93.     $self->_prepend($node);
  94.  
  95.     return $node;
  96. }
  97.  
  98. sub get {
  99.     my ($self, $key) = @_;
  100.     my $node = $self->_get($key);
  101.     if ($node) {
  102.         $self->{hits}++;
  103.         dbg("cache: hit: " . $self->{hits} . " " . $key);
  104.         return $node->{value};
  105.     }
  106.  
  107.     $self->{misses}++;
  108.     dbg("cache: miss: " . $self->{misses} . " " . $key);
  109.     return undef;
  110. }
  111.  
  112. sub set {
  113.     my ($self, $key, $value, $ttl) = @_;
  114.  
  115.     $ttl ||= $self->{ttl};
  116.  
  117.     my $node = $self->_get($key);
  118.     return if defined $node;
  119.  
  120.     dbg("cache: adding key $key for $ttl secs, " . $self->{count} . " items");
  121.     $node = {
  122.         key => $key,
  123.         value => $value,
  124.         expiry => time() + $ttl,
  125.         prev => undef,
  126.         next => undef
  127.     };
  128.     $self->_prepend($node);
  129. }
  130.  
  131. sub remove {
  132.     my ($self, $key) = @_;
  133.     
  134.     my $node = $self->_get($key);
  135.     return unless defined $node;
  136.  
  137.     $self->_rem($node);
  138. }
  139.  
  140. sub stats {
  141.     my ($self) = @_;
  142.     
  143.     return ($self->{hits}, $self->{misses});
  144. }
  145.  
  146. 1;
  147.