File Coverage

blib/lib/Cache/Cascade.pm

Criterion	Covered	Total	%
statement	39	85	45.8
branch	11	26	42.3
condition	1	2	50.0
subroutine	8	19	42.1
pod	13	13	100.0
total	72	145	49.6

#!/usr/bin/perl

package Cache::Cascade;
use Any::Moose;

use Carp qw/croak/;

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

use namespace::clean -except => [qw(meta)];

our $VERSION = "0.05";

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__->meta->make_immutable if __PACKAGE__->meta->can("make_immutable");

__PACKAGE__;

__END__