package Autocache::Strategy::Eviction::FIFO; use Any::Moose; extends 'Autocache::Strategy'; use Carp qw( confess ); use Devel::Size qw( total_size ); use Autocache::Logger qw( get_logger ); has 'size' => ( is => 'rw', isa => 'Int', default => 0, ); has 'max_size' => ( is => 'ro', isa => 'Int', default => 1024, ); # # queue of keys as we have seen them set # has '_queue' => ( is => 'rw', lazy_build => 1, ); # # map of keys to sizes # has '_map' => ( is => 'rw', lazy_build => 1, ); # # base_strategy : underlying strategy that handles storage and expiry - # defaults # has 'base_strategy' => ( is => 'ro', isa => 'Autocache::Strategy', lazy_build => 1, ); # # get REQ # sub get { my ($self,$req) = @_; get_logger()->debug( 'get: ' . $req->key ); return $self->base_strategy->get( $req ) } # # set REQ REC # sub set { my ($self,$req,$rec) = @_; get_logger()->debug( 'set: ' . $req->key ); my $size = $self->size; my ( $key, $rec_size ) = $self->_remove_entry( $req->key ); if( $key ) { $size -= $rec_size; } $key = $req->key; $rec_size = total_size( $rec ); $size += $rec_size; while( $size > $self->max_size ) { get_logger()->debug( "cache size: $size" ); my ( $victim_key, $victim_size ) = $self->_remove_entry; get_logger()->debug( "FIFO key: " . $victim_key ); $size -= $victim_size; $self->base_strategy->delete( $victim_key ); } $self->size( $size ); push @{$self->_queue}, $key; $self->_map->{$key} = $rec_size; return $self->base_strategy->set( $req, $rec ); } # # delete KEY # sub delete { my ($self,$key) = @_; get_logger()->debug( "delete: $key" ); my $size = $self->size; my ( $removed_key, $rec_size ) = $self->_remove_entry( $key ); if( $removed_key ) { $size -= $rec_size; $self->size( $size ); } my $rec = $self->base_strategy->delete( $key ); return $rec; } # # clear # sub clear { my ($self,$key) = @_; get_logger()->debug( "clear" ); $self->base_strategy->clear; $self->_queue = []; $self->_map = {}; $self->size( 0 ); } # # _remove_entry [KEY] # # remove an entry from our queue and map. returns the key removed and the # record size. defaults to removing the first item on the queue. # sub _remove_entry { my ($self,$key) = @_; get_logger()->debug( "_remove_entry" ); if( scalar @{$self->_queue} ) { # default to first in $key ||= $self->_queue->[0]; if( my $size = delete $self->_map->{$key} ) { @{$self->_queue} = grep { $_ ne $key } @{$self->_queue}; return wantarray ? ( $key, $size ) : $key; } } return undef; } sub _build__queue { return []; } sub _build__map { return {}; } around BUILDARGS => sub { my $orig = shift; my $class = shift; get_logger()->debug( __PACKAGE__ . " - BUILDARGS" ); if( ref $_[0] ) { my $config = $_[0]; my %args; my $node; if( $node = $config->get_node( 'max_size' ) ) { get_logger()->debug( "max_size node found" ); $args{max_size} = $node->value; } if( $node = $config->get_node( 'base_strategy' ) ) { get_logger()->debug( "base strategy node found" ); $args{base_strategy} = Autocache->singleton->get_strategy( $node->value ); } return $class->$orig( %args ); } else { return $class->$orig(@_); } }; no Any::Moose; __PACKAGE__->meta->make_immutable; 1;