X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FLRU.pm;h=5084a69530c3bbfe126b66d7cbed25e1d27088e0;hb=963a74a359bda8ac6c348977f70d85e8e879697a;hp=29fd3c87e46b048525938ab385c73f6d4f4b48b8;hpb=1172aa77de530206b0dbb648d8489922a518d502;p=spider.git diff --git a/perl/LRU.pm b/perl/LRU.pm index 29fd3c87..5084a695 100644 --- a/perl/LRU.pm +++ b/perl/LRU.pm @@ -3,7 +3,7 @@ # # Copyright (c) 2002 Dirk Koopman, Tobit Computer Co Ltd # -# $Id$ +# # # The structure of the objects stored are:- # @@ -11,7 +11,7 @@ # # The structure of the base is:- # -# [next, prev, max objects, count, ] +# [next, prev, max objects, count ] # # @@ -26,27 +26,27 @@ use DXDebug; use vars qw(@ISA); @ISA = qw(Chain); -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; +use constant OBJ => 2; +use constant MAX => 3; +use constant INUSE => 4; +use constant NAME => 5; +use constant CALLBACK => 6; sub newbase { my $pkg = shift; my $name = shift; my $max = shift; - my $coderef = shift; + my $callback = shift; confess "LRU->newbase requires a name and maximal count" unless $name && $max; - return $pkg->SUPER::new({ }, $max, 0, $name, $coderef); + return $pkg->SUPER::new({ }, $max, 0, $name, $callback); } sub get { my ($self, $call) = @_; if (my $p = $self->obj->{$call}) { - dbg("LRU $self->[5] cache hit $call") if isdbg('lru'); + dbg("LRU $self->[NAME] cache hit $call") if isdbg('lru'); $self->rechain($p); return $p->obj; } @@ -60,43 +60,43 @@ sub put my $p = $self->obj->{$call}; if ($p) { # update the reference and rechain it - dbg("LRU $self->[5] cache update $call") if isdbg('lru'); + dbg("LRU $self->[NAME] cache update $call") if isdbg('lru'); $p->obj($ref); $self->rechain($p); } else { # delete one of the end of the chain if required - while ($self->[4] >= $self->[3] ) { + while ($self->[INUSE] >= $self->[MAX] ) { $p = $self->prev; - my $call = $p->[3]; - dbg("LRU $self->[5] cache LRUed out $call now $self->[4]/$self->[3]") if isdbg('lru'); + my $call = $p->[MAX]; + dbg("LRU $self->[NAME] cache LRUed out $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru'); $self->remove($call); } # add a new one - dbg("LRU $self->[5] cache add $call now $self->[4]/$self->[3]") if isdbg('lru'); + dbg("LRU $self->[NAME] cache add $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru'); $p = $self->new($ref, $call); $self->add($p); $self->obj->{$call} = $p; - $self->[4]++; + $self->[INUSE]++; } } sub remove { my ($self, $call) = @_; - my $q = $self->obj->{$call}; - confess("$call is already removed") unless $q; - dbg("LRU $self->[5] cache remove $call now $self->[4]/$self->[3]") if isdbg('lru'); - &{$self->[5]}($q->obj) if $self->[5]; - $q->obj(1); - $q->SUPER::del; + my $p = $self->obj->{$call}; + confess("$call is already removed") unless $p; + dbg("LRU $self->[NAME] cache remove $call now $self->[INUSE]/$self->[MAX]") if isdbg('lru'); + &{$self->[CALLBACK]}($p->obj) if $self->[CALLBACK]; # call back if required + $p->obj(1); + $p->SUPER::del; delete $self->obj->{$call}; - $self->[4]--; + $self->[INUSE]--; } sub count { - return $_[0]->[4]; + return $_[0]->[INUSE]; } 1;