Limit the size of the result caches

The neighbourhood, classic collocator and similar profile caches grew by one
entry per queried word and were never evicted, so a long running worker
eventually exhausted the machine's memory. They are size limited Mojo::Cache
instances now, configurable in the new cache section of the configuration
file.

The neighbourhood cache never hit anyway: the lookup used a comma inside the
hash subscript, i.e. a $; joined multidimensional key, the value was read with
a second key and stored under a third one that did not include
searchBaseVocabFirst at all.

Starting the server with -C now really bypasses the caches. It did not before,
because $opt_C was read in IDS::DeReKoVecs::Read but set in main.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Change-Id: I17b801df54137ea81b660229bf789725de5a2b1b
diff --git a/lib/IDS/DeReKoVecs/Read.pm b/lib/IDS/DeReKoVecs/Read.pm
index 7bff3af..fffa9e5 100644
--- a/lib/IDS/DeReKoVecs/Read.pm
+++ b/lib/IDS/DeReKoVecs/Read.pm
@@ -8,12 +8,16 @@
 my $src_file      = undef;
 
 our $mergedEnd=0;
-our %cache;
-our %cccache; # classic collocator cache
-our %spcache; # similar profile cache
 our $opt_p = 5676;
 our $opt_C;
 
+# Cached values are large (a classic collocator profile is tens to hundreds of
+# kilobytes of JSON), so the caches are size limited. Without a limit a long
+# running worker accumulates one entry per queried word until the box runs out
+# of memory. Defaults can be overridden via configure_cache().
+our $CC_CACHE_MAX_KEYS = 200;  # classic collocators
+our $SP_CACHE_MAX_KEYS = 200;  # similar profiles
+
 BEGIN {
   $src_file = __FILE__;
   $src_file =~ s/Read.pm/derekovecs-server.c/;
@@ -24,9 +28,40 @@
 #use Inline C => Config => CLEAN_AFTER_BUILD => 0, ccflags => $Config{ccflags}." -Ofast -march k8 -mtune k8 ";
 
 use Mojo::JSON qw(decode_json encode_json to_json);
+use Mojo::Cache;
 use Exporter qw(import);
 
-our @EXPORT = qw(init_net load_sprofiles getVocabSize getDowntimeCalendar getCollocationAssociation getClassicCollocatorsCached getSimilarProfiles getSimilarProfilesCached getBiggestMergedDifferences filter_garbage get_neighbours getWordNumber dump_vecs dump_for_numpy cos_similarity_as_json get_version getPosWiseW2VCollocators);
+our @EXPORT = qw(init_net load_sprofiles getVocabSize getDowntimeCalendar getCollocationAssociation getClassicCollocatorsCached getSimilarProfiles getSimilarProfilesCached getBiggestMergedDifferences filter_garbage get_neighbours getWordNumber dump_vecs dump_for_numpy cos_similarity_as_json get_version getPosWiseW2VCollocators configure_cache cache_stats);
+
+my $cccache = Mojo::Cache->new(max_keys => $CC_CACHE_MAX_KEYS); # classic collocator cache
+my $spcache = Mojo::Cache->new(max_keys => $SP_CACHE_MAX_KEYS); # similar profile cache
+
+# Adjust the caches at startup, e.g.
+#   configure_cache(collocators_max_keys => 500, no_cache => 1)
+# A max_keys value <= 0 disables the respective cache. Setting a limit starts
+# from an empty cache, so that a lowered limit takes effect immediately.
+sub configure_cache {
+  my (%opt) = @_;
+  $opt_C = $opt{no_cache} if defined $opt{no_cache};
+  $cccache = Mojo::Cache->new(max_keys => $opt{collocators_max_keys})
+    if defined $opt{collocators_max_keys};
+  $spcache = Mojo::Cache->new(max_keys => $opt{profiles_max_keys})
+    if defined $opt{profiles_max_keys};
+  return;
+}
+
+sub cache_stats {
+  return {
+    collocators => {
+      keys     => scalar keys %{$cccache->{cache} || {}},
+      max_keys => $cccache->max_keys
+    },
+    profiles => {
+      keys     => scalar keys %{$spcache->{cache} || {}},
+      max_keys => $spcache->max_keys
+    }
+  };
+}
 
 sub getDowntimeCalendar {
   my ($url) = @_;
@@ -55,11 +90,13 @@
     open $pipe, "lwp-request $compare_to/getClassicCollocators?w=$word |";
   }
 
-  if($opt_C || !$cccache{$word}) {
+  my $collocators = $opt_C ? undef : $cccache->get($word);
+  if(!defined $collocators) {
     $c->app->log->info("Getting classic collocates of $word.");
-    $cccache{$word} = getClassicCollocators($word);
-    $cccache{$word} =~ s/:(-?)(nan|inf)/:"${1}${2}"/g;
-    $cccache{$word} =~ s/"""/"\\""/g;
+    $collocators = getClassicCollocators($word);
+    $collocators =~ s/:(-?)(nan|inf)/:"${1}${2}"/g;
+    $collocators =~ s/"""/"\\""/g;
+    $cccache->set($word => $collocators) unless $opt_C;
   } else {
     $c->app->log->info("Getting classic collocates for $word from cache.");
   }
@@ -72,7 +109,7 @@
   }
 
   if(length($s2) > 2000) {
-    my $d1 = decode_json($cccache{$word});
+    my $d1 = decode_json($collocators);
     my $d2 = decode_json($s2);
     my %d2ld;
     my $minLd = 14;
@@ -86,7 +123,7 @@
     }
     return(encode_json($d1));
   } else {
-    my $d1 = decode_json($cccache{$word});
+    my $d1 = decode_json($collocators);
     foreach my $i (@{$d1->{collocates}}) {
       $i->{delta} = 0;
     }
@@ -96,12 +133,14 @@
 
 sub getSimilarProfilesCached {
   my ($c, $word) = @_;
-  if(!$spcache{$word}) {
-    $spcache{$word} = getSimilarProfiles($word);
+  my $profiles = $opt_C ? undef : $spcache->get($word);
+  if(!defined $profiles) {
+    $profiles = getSimilarProfiles($word);
+    $spcache->set($word => $profiles) unless $opt_C;
   } else {
     $c->app->log->info("Getting similar profiles for $word from cache:");
   }
-  return $spcache{$word};
+  return $profiles;
 }
 
 return 1;