File Coverage

blib/lib/Cache/Cascade.pm

Criterion	Covered	Total	%
statement	90	95	94.7
branch	20	28	71.4
condition	1	2	50.0
subroutine	22	22	100.0
pod	13	13	100.0
total	146	160	91.2

package Cache::Cascade; # git description: v0.06-3-g9cbe01e
# ABSTRACT: Get/set values to/from a group of caches, with some advanced semantics.

use strictures 2;
use Moo;
use Carp qw/croak/;
use Types::Standard qw(ArrayRef Bool);

sub _eval {
	my ( $code, %args ) = @_;
	$code =~ s/\[%\s*(\w+)\s*%\]/$args{$1} || die "$1 is not in eval" /ge;
	eval $code;
}

use namespace::autoclean;

our $VERSION = '0.07';

has caches => (
	isa => ArrayRef,
	is  => "rw",
);

has float_hits => (
	isa => Bool,
	is  => "rw",
	default => 0,
);

has set_deep => (
	isa => Bool,
	is  => "rw",
	default => 1,
);


sub get {
	my ( $self, $key ) = @_;

	if ( $self->float_hits ) {
		$self->get_and_float_result( $key, @{ $self->caches } );
	} else {
		foreach my $cache ( @{ $self->caches } ) {
			if ( defined( my $res = $cache->get($key) ) ) {
				return $res;
			}
		}

		return;
	}
}

sub get_and_float_result {
	my ( $self, $key, $head, @tail ) = @_;
	$head || return;

	if ( defined( my $res = $head->get($key) ) ) {
		return $res;
	} elsif ( @tail ) {
		if ( defined( my $res = $self->get_and_float_result( $key, @tail ) ) ) {
			$head->set( $key, $res );
			return $res;
		}
	}

	return;
}

sub set {
	my ( $self, $key, $value, @extra ) = @_;

	if ( $self->set_deep ) {
		$_->set($key, $value, @extra) for @{ $self->caches };
	} else {
		( $self->caches->[0] || return )->set($key, $value, @extra);
	}
}


BEGIN {
	foreach my $method (qw(size count)) {
		_eval <<'CODE', method => $method;
sub [% method %] {
	my $self = shift;
	return $self->_sum_[% method %]( @{ $self->caches } )
}

sub _sum_[% method %] {
	my ( $self, $head, @tail ) = @_;
	$head || return 0;
	$head->[% method %] + $self->_sum_[% method %]( @tail );
}
CODE
	}

	foreach my $method (qw(remove clear set_load_callback set_validate_callback)) {
		_eval <<'CODE', method => $method;
sub [% method %] {
	my ( $self, @args ) = @_;
	$_->[% method %]( @args ) for @{ $self->caches };
}
CODE
	}

	foreach my $method (qw(entry exists load_callback validate_callback)) {
		_eval <<'CODE', method => $method;
sub [% method %] {
	my ( $self, @args ) = @_;

	foreach my $cache ( @{ $self->caches } ) {
		if ( my $res = $cache->[% method %]( @args ) ) {
			return $res;
		}
	}

	return;
}
CODE
	}
}

__PACKAGE__;

__END__