File Coverage

blib/lib/WWW/ARDB/Cache.pm

Criterion	Covered	Total	%
statement	48	56	85.7
branch	9	16	56.2
condition	2	9	22.2
subroutine	11	12	91.6
pod	3	3	100.0
total	73	96	76.0

package WWW::ARDB::Cache;
our $AUTHORITY = 'cpan:GETTY';

# ABSTRACT: File-based cache for WWW::ARDB

use Moo;
use Types::Standard qw( Str InstanceOf );
use Path::Tiny qw( path );
use Digest::MD5 qw( md5_hex );
use JSON::MaybeXS qw( encode_json decode_json );
use namespace::clean;

our $VERSION = '0.002';


has cache_dir => (
    is      => 'lazy',
    isa     => InstanceOf['Path::Tiny'],
    coerce  => sub { ref $_[0] ? $_[0] : path($_[0]) },
    builder => '_build_cache_dir',
);


sub _build_cache_dir {
    my $self = shift;

    my $base;
    if ($^O eq 'MSWin32') {
        $base = path($ENV{LOCALAPPDATA} || $ENV{APPDATA} || $ENV{HOME});
    } else {
        $base = path($ENV{XDG_CACHE_HOME} || "$ENV{HOME}/.cache");
    }

    my $dir = $base->child('ardb');
    $dir->mkpath unless $dir->exists;

    return $dir;
}

has namespace => (
    is      => 'ro',
    isa     => Str,
    default => 'default',
);


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

    my $file = $self->_cache_file($endpoint, $params);
    return unless $file->exists;

    my $content = $file->slurp_utf8;
    my $cached = decode_json($content);

    return $cached->{data};
}


sub set {
    my ($self, $endpoint, $params, $data) = @_;

    my $file = $self->_cache_file($endpoint, $params);
    $file->parent->mkpath unless $file->parent->exists;

    my $cache_data = {
        timestamp => time(),
        endpoint  => $endpoint,
        data      => $data,
    };

    $file->spew_utf8(encode_json($cache_data));
}


sub clear {
    my ($self, $endpoint) = @_;

    if ($endpoint) {
        my $pattern = $self->_cache_key($endpoint, {});
        $pattern =~ s/_[a-f0-9]+$//;
        for my $file ($self->cache_dir->children) {
            if ($file->basename =~ /^\Q$pattern\E/) {
                $file->remove;
            }
        }
    } else {
        for my $file ($self->cache_dir->children) {
            $file->remove if $file->is_file;
        }
    }
}


sub _cache_key {
    my ($self, $endpoint, $params) = @_;

    my $key = $self->namespace . '_' . $endpoint;
    $key =~ s/[\/\s]/_/g;

    if ($params && %$params) {
        my $param_str = encode_json($params);
        $key .= '_' . md5_hex($param_str);
    }

    return $key;
}

sub _cache_file {
    my ($self, $endpoint, $params) = @_;

    my $key = $self->_cache_key($endpoint, $params);
    return $self->cache_dir->child($key . '.json');
}

1;

__END__