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,
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 {
+sub fid_for {
my ($self, $folder, $rw) = @_;
- my $dbh = $self->{dbh};
+ my $dbh = $self->{dbh} //= dbh_new($self, $rw);
my $sel = 'SELECT fid FROM folders WHERE loc = ? LIMIT 1';
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(<<EOM, undef, $folder, $fid) if $rw;
sub set_src {
my ($self, $oidhex, $folder, $id) = @_;
- my $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder, 1);
+ my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1);
my $sth;
if (ref($id)) { # scalar name
$id = $$id;
sub clear_src {
my ($self, $folder, $id) = @_;
- my $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder, 1);
+ my $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder, 1);
my $sth;
if (ref($id)) { # scalar name
$id = $$id;
# Maildir-only
sub mv_src {
my ($self, $folder, $oidbin, $id, $newbn) = @_;
- my $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder, 1);
+ 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
my ($self, $folder, $cb, @args) = @_;
my $dbh = $self->{dbh} //= dbh_new($self);
my ($fid, $sth);
- $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder) // return;
+ 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) {
my $dbh = $self->{dbh} //= dbh_new($self);
my $fid;
my $ret = {};
- $fid = $self->{fmap}->{$folder} //= _fid_for($self, $folder) // return;
+ $fid = $self->{fmap}->{$folder} //= fid_for($self, $folder) // return;
my ($row) = $dbh->selectrow_array(<<"", undef, $fid);
SELECT COUNT(name) FROM blob2name 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;
}
$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;
"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(<<EOM) if @$folders;
+--all= not compatible with @$folders on command-line
+EOM
+ my %x = map { $_ => $_ } split(/,/, $all);
+ my @ok = grep(defined, delete(@x{qw(local remote), ''}));
+ my @no = keys %x;
+ if (@no) {
+ @no = (join(',', @no));
+ return $lei->fail(<<EOM);
+--all=@no not accepted (must be `local' and/or `remote')
+EOM
+ }
+ my (%seen, @inc);
+ my @all = $self->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;
+ }
+ for (@inc) {
+ push(@$folders, $_) unless $seen{$_}++;
+ }
+ }
+ scalar(@$folders) || $lei->fail(<<EOM);
+no --mail-sync folders known to lei
+EOM
+}
+
# map CLI args to folder table entries, returns undef on failure
sub arg2folder {
my ($self, $lei, $folders) = @_;
$err;
}
+sub forget_folder {
+ my ($self, $folder) = @_;
+ my ($fid, $sth);
+ $fid = delete($self->{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);
+}
+
+# only used for changing canonicalization errors
+sub rename_folder {
+ my ($self, $old, $new) = @_;
+ my $fid = delete($self->{fmap}->{$old}) //
+ fid_for($self, $old) // return;
+ $self->{dbh}->do(<<EOM, undef, $new, $fid);
+UPDATE folders SET loc = ? WHERE fid = ?
+EOM
+}
+
+sub imap_oidbin ($$$) {
+ my ($self, $url, $uid) = @_; # $url MUST have UIDVALIDITY
+ my $fid = $self->{fmap}->{$url} //= fid_for($self, $url) // return;
+ my $sth = $self->{dbh}->prepare_cached(<<EOM, undef, 1);
+SELECT oidbin FROM blob2num WHERE fid = ? AND uid = ?
+EOM
+ $sth->execute($fid, $uid);
+ $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(<<EOM, undef, 1);
+SELECT oidbin FROM blob2name WHERE fid = ? AND name = ?
+EOM
+ $sth->execute($fid, $nm);
+ $sth->fetchrow_array;
+}
+
+sub imap_oid {
+ my ($self, $lei, $uid_uri) = @_;
+ my $mailbox_uri = $uid_uri->clone;
+ $mailbox_uri->uid(undef);
+ my $folders = [ $$mailbox_uri ];
+ if (my $err = $self->arg2folder($lei, $folders)) {
+ if ($err->{fail}) {
+ $lei->qerr("# no sync information for $mailbox_uri");
+ return;
+ }
+ $lei->qerr(@{$err->{qerr}}) if $err->{qerr};
+ }
+ my $oidbin = imap_oidbin($self, $folders->[0], $uid_uri->uid);
+ $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;