X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FLeiMailSync.pm;h=690c6477efa9c3be76242392d39fcdad90d1378e;hb=47d4e53734820b4e;hp=36cd564cd7477467b75e1f28ff6428c10af3b499;hpb=525d14996e820e7bf2b5e035cf5826b6530f6d92;p=public-inbox.git diff --git a/lib/PublicInbox/LeiMailSync.pm b/lib/PublicInbox/LeiMailSync.pm index 36cd564c..690c6477 100644 --- a/lib/PublicInbox/LeiMailSync.pm +++ b/lib/PublicInbox/LeiMailSync.pm @@ -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 ( @@ -54,6 +64,10 @@ CREATE TABLE IF NOT EXISTS blob2num ( UNIQUE (oidbin, fid, uid) ) + # speeds up LeiImport->ck_update_kw (for "lei import") by 5-6x: + $dbh->do(<<''); +CREATE INDEX IF NOT EXISTS idx_fid_uid ON blob2num(fid,uid) + $dbh->do(<<''); CREATE TABLE IF NOT EXISTS blob2name ( oidbin VARBINARY NOT NULL, @@ -62,6 +76,10 @@ CREATE TABLE IF NOT EXISTS blob2name ( UNIQUE (oidbin, fid, name) ) + # speeds up LeiImport->pmdir_cb (for "lei import") by ~6x: + $dbh->do(<<''); +CREATE INDEX IF NOT EXISTS idx_fid_name ON blob2name(fid,name) + } sub fid_for { @@ -71,8 +89,8 @@ sub fid_for { my ($fid) = $dbh->selectrow_array($sel, undef, $folder); return $fid if defined $fid; + # caller had trailing slash (LeiToMail) if ($folder =~ s!\A((?:maildir|mh):.*?)/+\z!$1!i) { - warn "folder: $folder/ had trailing slash in arg\n"; ($fid) = $dbh->selectrow_array($sel, undef, $folder); if (defined $fid) { $dbh->do(<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 @@ -123,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 @@ -146,33 +172,63 @@ 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 = ? - $sth->execute($newbn, $fid, $oidbin, $$id); + my $nr = $sth->execute($newbn, $fid, $oidbin, $$id); + if ($nr == 0) { # may race with a clear_src, ensure new value exists + $sth = $self->{dbh}->prepare_cached(<<''); +INSERT OR IGNORE INTO blob2name (oidbin, fid, name) VALUES (?, ?, ?) + + $sth->execute($oidbin, $fid, $newbn); + } } # read-only, iterates every oidbin + UID or name for a given folder 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; } } @@ -198,16 +254,16 @@ SELECT $op(uid) FROM blob2num WHERE fid = ? # returns a { location => [ list-of-ids-or-names ] } mapping sub locations_for { - my ($self, $oidhex) = @_; + my ($self, $oidbin) = @_; my ($fid, $sth, $id, %fid2id); my $dbh = $self->{dbh} //= dbh_new($self); $sth = $dbh->prepare('SELECT fid,uid FROM blob2num WHERE oidbin = ?'); - $sth->execute(pack('H*', $oidhex)); + $sth->execute($oidbin); while (my ($fid, $uid) = $sth->fetchrow_array) { push @{$fid2id{$fid}}, $uid; } $sth = $dbh->prepare('SELECT fid,name FROM blob2name WHERE oidbin = ?'); - $sth->execute(pack('H*', $oidhex)); + $sth->execute($oidbin); while (my ($fid, $name) = $sth->fetchrow_array) { push @{$fid2id{$fid}}, $name; } @@ -217,6 +273,7 @@ sub locations_for { $sth->execute($fid); my ($loc) = $sth->fetchrow_array; unless (defined $loc) { + my $oidhex = unpack('H*', $oidbin); warn "E: fid=$fid for $oidhex unknown:\n", map { 'E: '.(ref() ? $$_ : "#$_")."\n"; } @$ids; @@ -307,6 +364,41 @@ sub match_imap_url { "E: `$url' is ambiguous:\n\t".join("\n\t", @match)."\n"; } +# returns undef on failure, number on success +sub group2folders { + my ($self, $lei, $all, $folders) = @_; + return $lei->fail(< $_ } split(/,/, $all); + my @ok = grep(defined, delete(@x{qw(local remote), ''})); + push(@ok, '') if $all eq ''; + my @no = keys %x; + if (@no) { + @no = (join(',', @no)); + return $lei->fail(<folders; + for my $ok (@ok) { + if ($ok eq 'local') { + @inc = grep(!m!\A[a-z0-9\+]+://!i, @all); + } elsif ($ok eq 'remote') { + @inc = grep(m!\A[a-z0-9\+]+://!i, @all); + } elsif ($ok ne '') { + return $lei->fail("--all=$all not understood"); + } else { + @inc = @all; + } + push(@$folders, (grep { !$seen{$_}++ } @inc)); + } + scalar(@$folders) || $lei->fail(<{fmap}->{$folder}) // - fid_for($self, $folder) // return; - my $dbh = $self->{dbh}; - $dbh->do('DELETE FROM blob2name WHERE fid = ?', undef, $fid); - $dbh->do('DELETE FROM blob2num WHERE fid = ?', undef, $fid); - $dbh->do('DELETE FROM folders 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); + } + } } -sub imap_oid2 ($$$) { - my ($self, $uri, $uid) = @_; # $uri MUST have UIDVALIDITY - my $fid = $self->{fmap}->{"$uri"} //= fid_for($self, "$uri") // return; +# 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 { + $self->{dbh}->do(<{fmap}->{$new} // fid_for($self, $new); + for my $t (qw(blob2name blob2num)) { + $self->{dbh}->do(<{dbh}->do(<{fmap}->{$url} //= fid_for($self, $url) // return; my $sth = $self->{dbh}->prepare_cached(<execute($fid, $uid); - my ($oidbin) = $sth->fetchrow_array; - $oidbin ? unpack('H*', $oidbin) : undef; + $sth->fetchrow_array; +} + +sub name_oidbin ($$$) { + my ($self, $mdir, $nm) = @_; + my $fid = $self->{fmap}->{$mdir} //= fid_for($self, $mdir) // return; + my $sth = $self->{dbh}->prepare_cached(<execute($fid, $nm); + $sth->fetchrow_array; } sub imap_oid { @@ -384,18 +511,8 @@ sub imap_oid { } $lei->qerr(@{$err->{qerr}}) if $err->{qerr}; } - imap_oid2($self, $folders->[0], $uid_uri->uid); -} - - -# FIXME: something with "lei " is causing uncommitted transaction -# warnings, not sure what... -sub DESTROY { - my ($self) = @_; - my $dbh = $self->{dbh} or return; - return if $dbh->{ReadOnly}; - use Carp; - warn "BUG $$ $0 $self {dbh} UNCOMMITTED ", Carp::longmess(); + my $oidbin = imap_oidbin($self, $folders->[0], $uid_uri->uid); + $oidbin ? unpack('H*', $oidbin) : undef; } 1;