The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;