lib/PublicInbox/SharedKV.pm

   1 # Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # fork()-friendly key-value store.  Will be used for making
   5 # augmenting Maildirs and mboxes less expensive, maybe.
   6 # We use flock(2) to avoid SQLite lock problems (busy timeouts, backoff)
   7 package PublicInbox::SharedKV;
   8 use strict;
   9 use v5.10.1;
  10 use parent qw(PublicInbox::Lock);
  11 use File::Temp qw(tempdir);
  12 use DBI ();
  13 use PublicInbox::Spawn;
  14 use File::Path qw(rmtree make_path);
  15
  16 sub dbh {
  17         my ($self, $lock) = @_;
  18         $self->{dbh} //= do {
  19                 my $f = $self->{filename};
  20                 $lock //= $self->lock_for_scope_fast;
  21                 my $dbh = DBI->connect("dbi:SQLite:dbname=$f", '', '', {
  22                         AutoCommit => 1,
  23                         RaiseError => 1,
  24                         PrintError => 0,
  25                         sqlite_use_immediate_transaction => 1,
  26                         # no sqlite_unicode here, this is for binary data
  27                 });
  28                 my $opt = $self->{opt} // {};
  29                 $dbh->do('PRAGMA synchronous = OFF') if !$opt->{fsync};
  30                 if (my $s = $opt->{cache_size}) {
  31                         $dbh->do("PRAGMA cache_size = $s");
  32                 }
  33                 $dbh->do('PRAGMA journal_mode = '.
  34                                 ($opt->{journal_mode} // 'WAL'));
  35                 $dbh->do(<<'');
  36 CREATE TABLE IF NOT EXISTS kv (
  37         k VARBINARY PRIMARY KEY NOT NULL,
  38         v VARBINARY NOT NULL,
  39         UNIQUE (k)
  40 )
  41
  42                 $dbh;
  43         }
  44 }
  45
  46 sub new {
  47         my ($cls, $dir, $base, $opt) = @_;
  48         my $self = bless { opt => $opt }, $cls;
  49         make_path($dir) if defined($dir) && !-d $dir;
  50         $dir //= $self->{"tmp$$.$self"} = tempdir("skv.$$-XXXX", TMPDIR => 1);
  51         $base //= '';
  52         my $f = $self->{filename} = "$dir/$base.sqlite3";
  53         $self->{lock_path} = $opt->{lock_path} // "$dir/$base.flock";
  54         unless (-f $f) {
  55                 open my $fh, '+>>', $f or die "failed to open $f: $!";
  56                 PublicInbox::Spawn::nodatacow_fd(fileno($fh));
  57         }
  58         $self;
  59 }
  60
  61 sub index_values {
  62         my ($self) = @_;
  63         my $lock = $self->lock_for_scope_fast;
  64         $self->dbh($lock)->do('CREATE INDEX IF NOT EXISTS idx_v ON kv (v)');
  65 }
  66
  67 sub set_maybe {
  68         my ($self, $key, $val, $lock) = @_;
  69         $lock //= $self->lock_for_scope_fast;
  70         my $e = $self->{dbh}->prepare_cached(<<'')->execute($key, $val);
  71 INSERT OR IGNORE INTO kv (k,v) VALUES (?, ?)
  72
  73         $e == 0 ? undef : $e;
  74 }
  75
  76 # caller calls sth->fetchrow_array
  77 sub each_kv_iter {
  78         my ($self) = @_;
  79         my $sth = $self->{dbh}->prepare_cached(<<'', undef, 1);
  80 SELECT k,v FROM kv
  81
  82         $sth->execute;
  83         $sth
  84 }
  85
  86 sub keys {
  87         my ($self) = @_;
  88         my $sth = $self->dbh->prepare_cached(<<'', undef, 1);
  89 SELECT k FROM kv
  90
  91         $sth->execute;
  92         map { $_->[0] } @{$sth->fetchall_arrayref};
  93 }
  94
  95 sub delete_by_val {
  96         my ($self, $val, $lock) = @_;
  97         $lock //= $self->lock_for_scope_fast;
  98         $self->{dbh}->prepare_cached(<<'')->execute($val) + 0;
  99 DELETE FROM kv WHERE v = ?
 100
 101 }
 102
 103 sub replace_values {
 104         my ($self, $oldval, $newval, $lock) = @_;
 105         $lock //= $self->lock_for_scope_fast;
 106         $self->{dbh}->prepare_cached(<<'')->execute($newval, $oldval) + 0;
 107 UPDATE kv SET v = ? WHERE v = ?
 108
 109 }
 110
 111 sub set {
 112         my ($self, $key, $val) = @_;
 113         if (defined $val) {
 114                 my $e = $self->{dbh}->prepare_cached(<<'')->execute($key, $val);
 115 INSERT OR REPLACE INTO kv (k,v) VALUES (?,?)
 116
 117                 $e == 0 ? undef : $e;
 118         } else {
 119                 $self->{dbh}->prepare_cached(<<'')->execute($key);
 120 DELETE FROM kv WHERE k = ?
 121
 122         }
 123 }
 124
 125 sub get {
 126         my ($self, $key) = @_;
 127         my $sth = $self->{dbh}->prepare_cached(<<'', undef, 1);
 128 SELECT v FROM kv WHERE k = ?
 129
 130         $sth->execute($key);
 131         $sth->fetchrow_array;
 132 }
 133
 134 sub xchg {
 135         my ($self, $key, $newval, $lock) = @_;
 136         $lock //= $self->lock_for_scope_fast;
 137         my $oldval = get($self, $key);
 138         if (defined $newval) {
 139                 set($self, $key, $newval);
 140         } else {
 141                 $self->{dbh}->prepare_cached(<<'')->execute($key);
 142 DELETE FROM kv WHERE k = ?
 143
 144         }
 145         $oldval;
 146 }
 147
 148 sub count {
 149         my ($self) = @_;
 150         my $sth = $self->{dbh}->prepare_cached(<<'');
 151 SELECT COUNT(k) FROM kv
 152
 153         $sth->execute;
 154         $sth->fetchrow_array;
 155 }
 156
 157 sub dbh_release {
 158         my ($self, $lock) = @_;
 159         my $dbh = delete $self->{dbh} or return;
 160         $lock //= $self->lock_for_scope_fast; # may be needed for WAL
 161         %{$dbh->{CachedKids}} = (); # cleanup prepare_cached
 162         $dbh->disconnect;
 163 }
 164
 165 sub DESTROY {
 166         my ($self) = @_;
 167         dbh_release($self);
 168         my $dir = delete $self->{"tmp$$.$self"} or return;
 169         my $tries = 0;
 170         do {
 171                 $! = 0;
 172                 eval { rmtree($dir) };
 173         } while ($@ && $!{ENOENT} && $tries++ < 5);
 174         warn "error removing $dir: $@" if $@;
 175         warn "Took $tries tries to remove $dir\n" if $tries;
 176 }
 177
 178 1;