File Coverage

blib/lib/Cache/Moustache.pm

Criterion	Covered	Total	%
statement	51	60	85.0
branch	18	32	56.2
condition	7	17	41.1
subroutine	13	13	100.0
pod	9	9	100.0
total	98	131	74.8

package Cache::Moustache;

use 5.005;
my $cpants = q/
use strict;
use warnings;
/;

BEGIN {
	$Cache::Moustache::AUTHORITY = 'cpan:TOBYINK';
	$Cache::Moustache::VERSION   = '0.006';
}

sub isa
{
	my $what = $_[1];
	return !!1 if {
		'Cache'            => 1,
		'Cache::Cache'     => 1,
		'Cache::FastMmap'  => 1,
		'Cache::Moustache' => 1,
		'Cache::Ref'       => 1,
		'CHI'              => 1,
		'Mojo::Cache'      => 1,
	}->{$what};
	return !!0;
}

sub new
{
	my ($class, %args) = @_;
	return $class if ref $class && $class->isa(__PACKAGE__);
	my %self = map { ;"~~~~$_" => $args{$_} } keys %args;
	$self{'~~~~default_expires_in'} ||= 3600;
	bless \%self, $class;
}

my %multipliers = (
	s        => 1,
	second   => 1,
	seconds  => 1,
	sec      => 1,
	m        => 60,
	minute   => 60,
	minutes  => 60,
	min      => 60,
	h        => 3600,
	hour     => 3600,
	hours    => 3600,
	d        => 86400,
	day      => 86400,
	days     => 86400,
	w        => 604800,
	week     => 604800,
	weeks    => 604800,
	M        => 2419200,
	month    => 2419200,
	months   => 2419200,
	y        => 31536000,
	year     => 31536000,
	years    => 31536000,
);

sub _clone
{
	require Storable;
	shift;
	goto \&Storable::dclone;
}

sub set
{
	my ($cache, $key, $data, $expires_in) = @_;
	return if $key =~ /^~~~~/;

	$data = $cache->_clone($data) if ref $data && $cache->{'~~~~clone_references'};

	$expires_in = $cache->{'~~~~default_expires_in'} if !defined $expires_in;

	if ($expires_in =~ /^(\d*)\s*([A-Za-z]+)$/)
	{
		($expires_in, my $mult) = ($1, $2);
		$expires_in = 1 unless defined $expires_in && length $expires_in;
		$expires_in *= ($multipliers{$mult} || $multipliers{lc $mult});
	}

	my $expires_at = ($expires_in < 0) ? $expires_in : (time + $expires_in);
	$cache->{$key} = [$data, $expires_at];
}

sub get
{
	my ($cache, $key) = @_;
	return if $key =~ /^~~~~/;
	return unless exists $cache->{$key};

	my $expires_at = $cache->{$key}[1];
	if ($expires_at >= 0 and $expires_at < time)
	{
		$cache->remove($key);
		return;
	}

	$cache->{$key}[0];
}

sub remove
{
	my ($cache, $key) = @_;

	if (ref $key eq 'Regexp') {
		my @keys = grep { $_ =~ $key and not !/^~~~~/ } keys %$cache;
		delete @{$cache}{@keys};
		return scalar(@keys);
	}

	return 0 if $key =~ /^~~~~/;
	return( (delete $cache->{$key}) ? 1 : 0 );
}

sub clear
{
	my $cache = shift;
	my @keys = grep !/^~~~~/, keys %$cache;
	delete $cache->{$_} for @keys;
	return scalar(@keys);
}

sub purge
{
	my $cache = shift;
	my $now   = time;
	my @keys  =
		grep { my $e = $cache->{$_}[1]; $e >= 0 && $e < $now }
		grep !/^~~~~/, keys %$cache;
	delete @{$cache}{@keys};
	return scalar(@keys);
}

sub get_keys
{
	my $cache = shift;
	my @keys = grep !/^~~~~/, keys %$cache;
	return @keys;
}

sub size
{
	scalar( my @keys = shift->get_keys );
}

sub AUTOLOAD
{
	return;
}

__PACKAGE__
__END__