gistfile1.pl

#!/usr/bin/env perl
# Memoize function persistently
# klg, Feb 2014
use strict;
use warnings 'all';
use Storable qw/freeze thaw/;
use Compress::Zlib;
use Fcntl ':flock';

sub pmemz($&) {
  my ($file, $sub) = @_;
  my $save = sub($;$) {
    my $data = compress freeze shift;
    my $fh = shift;
    open my $nf, '>:raw', "$file.cow" or die $!;
    flock $nf, LOCK_EX | LOCK_NB or die $!;
    print $nf $data or die $!;
    flock $fh, LOCK_EX or die $! if $fh;
    flock $nf, LOCK_UN;
    close $nf;
    rename "$file.cow", $file;
    open $nf, $file or die $!;
    flock $nf, LOCK_SH or die $!;
    close $fh if $fh;
    $fh = $nf;
  };
  my ($fh, $cache);
  open $fh, '<:raw', $file or ($fh = $save->({}));
  flock $fh, LOCK_SH or die $!;
  $cache = thaw uncompress do { local $/; <$fh> } or die $!;
  sub {
    my $key = freeze {0 => \@_};
    return @{$cache->{$key}} if $cache->{$key};
    $cache->{$key} = [$sub->(@_)];
    $fh = $save->($cache, $fh);
    return @{$cache->{$key}};
  }
}

## Example:

my $x = pmemz 'cache.file', sub($) {
  print "call(@_)\n";
  return 2+shift;
};

print $x->(3), "\n";
print $x->(5), "\n";
print $x->(4), "\n";
print $x->(3), "\n";