#!/usr/bin/env perl

use strict;
use warnings;
use v5.16;
use Test::More (tests => 4);

###############################################################################
###############################################################################

my $key = "foo";
my $val = "bar";

# Init the cache
cache($key, undef); # Clear cache

is(cache($key), undef);                    # Get empty value
is(cache($key , $val, time() + 2), undef); # Set value for two seconds
is(cache($key), "bar");                    # Fetch value we just set

print "Sleeping a couple seconds to let cache expire\n";
sleep(3);

is(cache($key), undef); # Entry should be expired now

########################################

print "\n";
my $verbose = 0;
my $c       = cache_clean("/dev/shm/perl-cache/", $verbose);
print "Cleaned $c cache entries\n";

###############################################################################
###############################################################################

# Cache get: cache($key);
# Cache set: cache($key, $val, $expires = 3600);
sub cache {
	use JSON::PP; use Tie::File; use File::Path; use Digest::SHA qw(sha256_hex);

	my ($key, $val, $expire, $ret, @data) = @_;

	my $hash = sha256_hex($key || "");
	my $dir  = "/dev/shm/perl-cache/" . substr($hash, 0, 3);
	my $file = "$dir/$hash.json";
	mkpath($dir);

	tie @data, 'Tie::File', $file or die("Unable to write $file"); # to r/w file

	if (@_ > 1) { # Set
		$data[0] = encode_json({ expires => int($expire || 3600), data => $val, key => $key });
	} elsif ($key && -r $file) { # Get
		eval { $ret = decode_json($data[0]); };
		if ($ret->{expires} && $ret->{expires} > time()) {
			$ret = $ret->{data};
		} else {
			unlink($file);
			$ret = undef;
		}
	}

	return $ret;
}

# $num = cache_clean($dir)
sub cache_clean {
	use Tie::File; use File::Basename;

	my ($dir, $verbose) = @_;
	my $ret = 0;

	# https://www.perturb.org/display/1306_Perl_Nested_subroutines.html
	local *dir_is_empty = sub {
		opendir(my $dh, $_[0]) or return undef;
		return scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0;
	};

	foreach my $file (glob("$dir/*/*.json")) {
		tie my @data, 'Tie::File', $file or die("Unable to write $file");
		my $x = decode_json($data[0] // {});

		if ($x->{expires} < time()) { # File is expired
			if ($verbose) { print "$file is expired\n"; }
			$ret += int(unlink($file));
		}
	}

	foreach my $dir (glob("$dir/*")) { # Directory is empty
		if (-d $dir && dir_is_empty($dir)) {
			if ($verbose) { print "$dir is empty\n"; }
			$ret += int(rmdir($dir));
		}
	}

	return int($ret);
}

# Debug print variable using either Data::Dump::Color (preferred) or Data::Dumper
# Creates methods k() and kd() to print, and print & die respectively
BEGIN {
	if (eval { require Data::Dump::Color }) {
		*k = sub { Data::Dump::Color::dd(@_) };
	} else {
		require Data::Dumper;
		*k = sub { print Data::Dumper::Dumper(\@_) };
	}

	sub kd {
		k(@_);

		printf("Died at %2\$s line #%3\$s\n",caller());
		exit(15);
	}
}

# vim: tabstop=4 shiftwidth=4 autoindent softtabstop=4