]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LeiMailSync.pm
lei_mail_sync: rely on flock(2), avoid IPC
[public-inbox.git] / lib / PublicInbox / LeiMailSync.pm
index 275e0cc4c433ce6b27fa43ee86984b5147885d6f..690c6477efa9c3be76242392d39fcdad90d1378e 100644 (file)
@@ -5,6 +5,7 @@
 package PublicInbox::LeiMailSync;
 use strict;
 use v5.10.1;
+use parent qw(PublicInbox::Lock);
 use DBI;
 use PublicInbox::ContentHash qw(git_sha);
 use Carp ();
@@ -21,7 +22,7 @@ sub dbh_new {
                sqlite_use_immediate_transaction => 1,
        });
        # no sqlite_unicode, here, all strings are binary
-       create_tables($dbh) if $rw;
+       create_tables($self, $dbh) if $rw;
        $dbh->do('PRAGMA journal_mode = WAL') if $creat;
        $dbh->do('PRAGMA case_sensitive_like = ON');
        $dbh;
@@ -29,15 +30,24 @@ sub dbh_new {
 
 sub new {
        my ($cls, $f) = @_;
-       bless { filename => $f, fmap => {} }, $cls;
+       bless {
+               filename => $f,
+               fmap => {},
+               lock_path => "$f.flock",
+       }, $cls;
 }
 
-sub lms_commit { delete($_[0]->{dbh})->commit }
+sub lms_write_prepare { ($_[0]->{dbh} //= dbh_new($_[0], 1)); $_[0] }
 
-sub lms_begin { ($_[0]->{dbh} //= dbh_new($_[0], 1))->begin_work };
+sub lms_pause {
+       my ($self) = @_;
+       $self->{fmap} = {};
+       delete $self->{dbh};
+}
 
 sub create_tables {
-       my ($dbh) = @_;
+       my ($self, $dbh) = @_;
+       my $lk = $self->lock_for_scope;
 
        $dbh->do(<<'');
 CREATE TABLE IF NOT EXISTS folders (
@@ -117,8 +127,15 @@ EOM
        $fid;
 }
 
+sub add_folders {
+       my ($self, @folders) = @_;
+       my $lk = $self->lock_for_scope;
+       for my $f (@folders) { $self->{fmap}->{$f} //= fid_for($self, $f, 1) }
+}
+
 sub set_src {
-       my ($self, $oidhex, $folder, $id) = @_;
+       my ($self, $oidbin, $folder, $id) = @_;
+       my $lk = $self->lock_for_scope;
        my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1);
        my $sth;
        if (ref($id)) { # scalar name
@@ -131,11 +148,12 @@ INSERT OR IGNORE INTO blob2name (oidbin, fid, name) VALUES (?, ?, ?)
 INSERT OR IGNORE INTO blob2num (oidbin, fid, uid) VALUES (?, ?, ?)
 
        }
-       $sth->execute(pack('H*', $oidhex), $fid, $id);
+       $sth->execute($oidbin, $fid, $id);
 }
 
 sub clear_src {
        my ($self, $folder, $id) = @_;
+       my $lk = $self->lock_for_scope;
        my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1);
        my $sth;
        if (ref($id)) { # scalar name
@@ -154,6 +172,7 @@ DELETE FROM blob2num WHERE fid = ? AND uid = ?
 # Maildir-only
 sub mv_src {
        my ($self, $folder, $oidbin, $id, $newbn) = @_;
+       my $lk = $self->lock_for_scope;
        my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1);
        my $sth = $self->{dbh}->prepare_cached(<<'');
 UPDATE blob2name SET name = ? WHERE fid = ? AND oidbin = ? AND name = ?
@@ -171,22 +190,45 @@ INSERT OR IGNORE INTO blob2name (oidbin, fid, name) VALUES (?, ?, ?)
 sub each_src {
        my ($self, $folder, $cb, @args) = @_;
        my $dbh = $self->{dbh} //= dbh_new($self);
-       my ($fid, $sth);
+       my $fid;
        if (ref($folder) eq 'HASH') {
                $fid = $folder->{fid} // die "BUG: no `fid'";
        } else {
                $fid = $self->{fmap}->{$folder} //=
                        fid_for($self, $folder) // return;
        }
-       $sth = $dbh->prepare('SELECT oidbin,uid FROM blob2num WHERE fid = ?');
-       $sth->execute($fid);
-       while (my ($oidbin, $id) = $sth->fetchrow_array) {
-               $cb->($oidbin, $id, @args);
+
+       # minimize implicit txn time to avoid blocking writers by
+       # batching SELECTs.  This looks wonky but is necessary since
+       # $cb-> may access the DB on its own.
+       my $ary = $dbh->selectall_arrayref(<<'', undef, $fid);
+SELECT _rowid_,oidbin,uid FROM blob2num WHERE fid = ?
+ORDER BY _rowid_ ASC LIMIT 1000
+
+       my $min = @$ary ? $ary->[-1]->[0] : undef;
+       while (defined $min) {
+               for my $row (@$ary) { $cb->($row->[1], $row->[2], @args) }
+
+               $ary = $dbh->selectall_arrayref(<<'', undef, $fid, $min);
+SELECT _rowid_,oidbin,uid FROM blob2num WHERE fid = ? AND _rowid_ > ?
+ORDER BY _rowid_ ASC LIMIT 1000
+
+               $min = @$ary ? $ary->[-1]->[0] : undef;
        }
-       $sth = $dbh->prepare('SELECT oidbin,name FROM blob2name WHERE fid = ?');
-       $sth->execute($fid);
-       while (my ($oidbin, $id) = $sth->fetchrow_array) {
-               $cb->($oidbin, \$id, @args);
+
+       $ary = $dbh->selectall_arrayref(<<'', undef, $fid);
+SELECT _rowid_,oidbin,name FROM blob2name WHERE fid = ?
+ORDER BY _rowid_ ASC LIMIT 1000
+
+       $min = @$ary ? $ary->[-1]->[0] : undef;
+       while (defined $min) {
+               for my $row (@$ary) { $cb->($row->[1], \($row->[2]), @args) }
+
+               $ary = $dbh->selectall_arrayref(<<'', undef, $fid, $min);
+SELECT _rowid_,oidbin,name FROM blob2name WHERE fid = ? AND _rowid_ > ?
+ORDER BY _rowid_ ASC LIMIT 1000
+
+               $min = @$ary ? $ary->[-1]->[0] : undef;
        }
 }
 
@@ -400,18 +442,23 @@ EOF
        $err;
 }
 
-sub forget_folder {
-       my ($self, $folder) = @_;
-       my $fid = delete($self->{fmap}->{$folder}) //
-               fid_for($self, $folder) // return;
-       for my $t (qw(blob2name blob2num folders)) {
-               $self->{dbh}->do("DELETE FROM $t WHERE fid = ?", undef, $fid);
+sub forget_folders {
+       my ($self, @folders) = @_;
+       my $lk = $self->lock_for_scope;
+       for my $folder (@folders) {
+               my $fid = delete($self->{fmap}->{$folder}) //
+                       fid_for($self, $folder) // next;
+               for my $t (qw(blob2name blob2num folders)) {
+                       $self->{dbh}->do("DELETE FROM $t WHERE fid = ?",
+                                       undef, $fid);
+               }
        }
 }
 
 # only used for changing canonicalization errors
 sub rename_folder {
        my ($self, $old, $new) = @_;
+       my $lk = $self->lock_for_scope;
        my $ofid = delete($self->{fmap}->{$old}) //
                fid_for($self, $old) // return;
        eval {
@@ -468,14 +515,4 @@ sub imap_oid {
        $oidbin ? unpack('H*', $oidbin) : undef;
 }
 
-# FIXED? something with "lei <up|q>" is causing uncommitted transaction
-# TODO: remove soon
-sub DESTROY {
-       my ($self) = @_;
-       my $dbh = delete($self->{dbh}) or return;
-       return if $dbh->{ReadOnly};
-       undef $dbh;
-       warn "BUG $$ $0 $self {dbh} OPEN ppid=".getppid.' '.Carp::longmess();
-}
-
 1;