package Cache::Ref::CLOCK::Base;
BEGIN {
$Cache::Ref::CLOCK::Base::AUTHORITY = 'cpan:NUFFIN';
}
BEGIN {
$Cache::Ref::CLOCK::Base::VERSION = '0.05'; # TRIAL
}
use Moose::Role;
use namespace::autoclean;
with qw(
Cache::Ref::Role::API
Cache::Ref::Role::Index
);
requires qw(_hit);
has size => (
isa => "Int",
is => "ro",
required => 1,
);
has _hand => (
isa => "ScalarRef",
is => "ro",
default => sub { my $x = -1; return \$x },
);
has _buffer => (
isa => "ArrayRef",
is => "ro",
lazy => 1,
default => sub {
my ( $self, $p ) = @_;
return [ map { [] } 1 .. $self->size ],
},
);
sub hit {
my ( $self, @keys ) = @_;
$self->_hit( [ grep { defined } $self->_index_get(@keys) ] );
return;
}
sub get {
my ( $self, @keys ) = @_;
my @ret;
my @entries = $self->_index_get(@keys);
$self->_hit( [ grep { defined } @entries ] );
return ( @keys == 1 ? ($entries[0] && $entries[0][2]) : map { $_ && $_->[2] } @entries );
}
sub clear {
my $self = shift;
$self->_index_clear;
@$_ = () for @{ $self->_buffer };
}
sub remove {
my ( $self, @keys ) = @_;
@$_ = () for $self->_index_delete(@keys);
}
sub set {
my ( $self, $key, $value ) = @_;
if ( my $e = $self->_index_get($key) ) {
$e->[2] = $value;
} else {
my $e = $self->_find_free_slot;
@$e = ( 0, $key, $value ); # start at 0, not k
$self->_index_set( $key, $e );
}
}
sub expire {
my ( $self, $how_many ) = @_;
my $i = $self->_hand;
my $b = $self->_buffer;
while ( $how_many ) {
if ( $$i == $#$b ) {
$$i = -1;
}
if ( my $e = $b->[++$$i] ) {
if ( !$e->[0] ) {
$self->remove($e->[1]); # also clears @$e
$how_many--;
} else {
$e->[0]--;
}
}
}
return;
}
sub _find_free_slot {
my $self = shift;
my $i = $self->_hand;
my $b = $self->_buffer;
loop: {
if ( $$i == $#$b ) {
$$i = -1;
}
my $e = $b->[++$$i];
if ( not @$e ) {
return $e;
} elsif ( !$e->[0] ) {
$self->remove($e->[1]); # also clears @$e
return $e;
} else {
$e->[0]--;
redo loop;
}
}
}
# ex: set sw=4 et:
__PACKAGE__;
__END__
=pod
=encoding utf-8
=head1 NAME
Cache::Ref::CLOCK::Base
=head1 AUTHOR
Yuval Kogman
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Yuval Kogman.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut