package FS::Cache;

use strict;
use warnings;

use Time::HiRes qw(time);

# TODO: for debugging only
use Mail::SpamAssassin::Logger;

sub new {
	my ($this, $max_size, $ttl) = @_;
	my $class = ref($this) || $this;
	my $self = {
		max_size => $max_size > 1 ? $max_size : 1,
		ttl => $ttl,
		count => 0,
		hits => 0,
		misses => 0,
		hash => {},
		list => [],
	};
	$self->{prev} = $self;
	$self->{next} = $self;
	bless $self, $class;

	dbg("cache: created cache with max_size = $self->{max_size}, ttl = $self->{ttl}");
	return $self;
}

sub _rem {
	my ($self, $node) = @_;

	# sanity check
	die unless $node->{prev} && $node->{next};

	my $prev = $node->{prev};
	my $next = $node->{next};

	# sanity check
	die unless $prev->{next} eq $node;
	die unless $next->{prev} eq $node;

	$prev->{next} = $next;
	$next->{prev} = $prev;

	$node->{prev} = undef;
	$node->{next} = undef;

	my $n = delete $self->{hash}->{$node->{key}};

	# sanity check
	die unless $n eq $node;

	$self->{count}--;
}

sub _prepend {
	my ($self, $node) = @_;
	
	my $first = $self->{next};
	
	$self->{next} = $node;
	$node->{next} = $first;

	$first->{prev} = $node;
	$node->{prev} = $self;
	
	$self->{hash}->{$node->{key}} = $node;
	++$self->{count};

	while ($self->{count} > $self->{max_size}) {
		$self->_rem($self->{prev});
	}
}

sub _get {
	my ($self, $key) = @_;

	my $h = $self->{hash};
	return undef unless exists $$h{$key};

	my $node = $$h{$key};

	# take the node off from its current position
	$self->_rem($node);

	# is it stale?
	dbg("cache: expired $key") if time() >= $node->{expiry};
	return undef if time() >= $node->{expiry};

	# move node first in the LRU list
	$self->_prepend($node);

	return $node;
}

sub get {
	my ($self, $key) = @_;
	my $node = $self->_get($key);
	if ($node) {
		$self->{hits}++;
		dbg("cache: hit: " . $self->{hits} . " " . $key);
		return $node->{value};
	}

	$self->{misses}++;
	dbg("cache: miss: " . $self->{misses} . " " . $key);
	return undef;
}

sub set {
	my ($self, $key, $value, $ttl) = @_;

	$ttl ||= $self->{ttl};

	my $node = $self->_get($key);
	return if defined $node;

	dbg("cache: adding key $key for $ttl secs, " . $self->{count} . " items");
	$node = {
		key => $key,
		value => $value,
		expiry => time() + $ttl,
		prev => undef,
		next => undef
	};
	$self->_prepend($node);
}

sub remove {
	my ($self, $key) = @_;
	
	my $node = $self->_get($key);
	return unless defined $node;

	$self->_rem($node);
}

sub stats {
	my ($self) = @_;
	
	return ($self->{hits}, $self->{misses});
}

1;
