projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fix 5.16.1 errors
[spider.git]
/
perl
/
LRU.pm
diff --git
a/perl/LRU.pm
b/perl/LRU.pm
index 29fd3c87e46b048525938ab385c73f6d4f4b48b8..5084a69530c3bbfe126b66d7cbed25e1d27088e0 100644
(file)
--- a/
perl/LRU.pm
+++ b/
perl/LRU.pm
@@
-3,7
+3,7
@@
#
# Copyright (c) 2002 Dirk Koopman, Tobit Computer Co Ltd
#
#
# Copyright (c) 2002 Dirk Koopman, Tobit Computer Co Ltd
#
-#
$Id$
+#
#
# The structure of the objects stored are:-
#
#
# The structure of the objects stored are:-
#
@@
-11,7
+11,7
@@
#
# The structure of the base is:-
#
#
# The structure of the base is:-
#
-# [next, prev, max objects, count
, <coderef to function to call on deletion>
]
+# [next, prev, max objects, count ]
#
#
#
#
@@
-26,27
+26,27
@@
use DXDebug;
use vars qw(@ISA);
@ISA = qw(Chain);
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;
sub newbase
{
my $pkg = shift;
my $name = shift;
my $max = shift;
- my $c
oderef
= shift;
+ my $c
allback
= shift;
confess "LRU->newbase requires a name and maximal count" unless $name && $max;
confess "LRU->newbase requires a name and maximal count" unless $name && $max;
- return $pkg->SUPER::new({ }, $max, 0, $name, $c
oderef
);
+ return $pkg->SUPER::new({ }, $max, 0, $name, $c
allback
);
}
sub get
{
my ($self, $call) = @_;
if (my $p = $self->obj->{$call}) {
}
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;
}
$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
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
$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;
$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
$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;
$p = $self->new($ref, $call);
$self->add($p);
$self->obj->{$call} = $p;
- $self->[
4
]++;
+ $self->[
INUSE
]++;
}
}
sub remove
{
my ($self, $call) = @_;
}
}
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};
delete $self->obj->{$call};
- $self->[
4
]--;
+ $self->[
INUSE
]--;
}
sub count
{
}
sub count
{
- return $_[0]->[
4
];
+ return $_[0]->[
INUSE
];
}
1;
}
1;