2 # A class implimenting LRU sematics with hash look up
4 # Copyright (c) 2002 Dirk Koopman, Tobit Computer Co Ltd
8 # The structure of the objects stored are:-
10 # [next, prev, obj, callsign]
12 # The structure of the base is:-
14 # [next, prev, max objects, count ]
29 use constant OBJ => 2;
30 use constant MAX => 3;
31 use constant INUSE => 4;
32 use constant NAME => 5;
33 use constant CALLBACK => 6;
41 confess "LRU->newbase requires a name and maximal count" unless $name && $max;
42 return $pkg->SUPER::new({ }, $max, 0, $name, $callback);
47 my ($self, $call) = @_;
48 if (my $p = $self->obj->{$call}) {
49 dbg("LRU $self->[NAME] cache hit $call") if isdbg('lru');
58 my ($self, $call, $ref) = @_;
59 confess("need a call and a reference") unless defined $call && $ref;
60 my $p = $self->obj->{$call};
62 # update the reference and rechain it
63 dbg("LRU $self->[NAME] cache update $call") if isdbg('lru');
67 # delete one of the end of the chain if required
68 while ($self->[INUSE] >= $self->[MAX] ) {
71 dbg("LRU $self->[NAME] cache LRUed out $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru');
76 dbg("LRU $self->[NAME] cache add $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru');
77 $p = $self->new($ref, $call);
79 $self->obj->{$call} = $p;
86 my ($self, $call) = @_;
87 my $p = $self->obj->{$call};
88 confess("$call is already removed") unless $p;
89 dbg("LRU $self->[NAME] cache remove $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru');
90 &{$self->[CALLBACK]}($p->obj) if $self->[CALLBACK]; # call back if required
93 delete $self->obj->{$call};
99 return $_[0]->[INUSE];