Warning: Undefined array key "search_mode" in /home/bakers/html/search.php on line 27

Warning: Undefined array key "include_body" in /home/bakers/html/search.php on line 28

Warning: Undefined array key 1313 in /home/bakers/html/search.php on line 247

Warning: Undefined variable $search_results in /home/bakers/html/search.php on line 257

Warning: Undefined variable $start in /home/bakers/html/search.php on line 261

Warning: Undefined variable $message in /home/bakers/html/search.php on line 63

Warning: Undefined variable $output in /home/bakers/html/search.php on line 65
Perturb.org - interesting technology related things from around the internet

Showing entries with tag "cache".

Found 1 entries

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