Perl: Simple file cache

I need a simple disk based object cache and Cache::File was overkill. I wrote my own dependency free (only core modules) version:

cache($key);                     # Get
cache($key, $val);               # Set expires is 1 hour (default)
cache($key, $val, time() + 900); # Set expires in 15 minutes
cache($key, undef)               # Delete

I purposely wrote it small so it can be copy/pasted in to other scripts simply. I wrote a more robust implementation with some basic tests as well. When an entry is fetched that is expired it will be removed from disk. Abandoned cache entries will persist on disk until cache_clean() is called.

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;
}
Leave A Reply
All content licensed under the Creative Commons License