]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LeiMailSync.pm
lei import: import IMAP flag changes from old messages
[public-inbox.git] / lib / PublicInbox / LeiMailSync.pm
index b298668658b650a7d269f96896e062e4e8ba835a..36cd564cd7477467b75e1f28ff6428c10af3b499 100644 (file)
@@ -7,6 +7,7 @@ use strict;
 use v5.10.1;
 use DBI;
 use PublicInbox::ContentHash qw(git_sha);
+use Carp ();
 
 sub dbh_new {
        my ($self, $rw) = @_;
@@ -63,9 +64,9 @@ CREATE TABLE IF NOT EXISTS blob2name (
 
 }
 
-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;
@@ -88,6 +89,10 @@ UPDATE folders SET loc = ? WHERE fid = ?
 EOM
                        return $fid;
                }
+       } elsif ($rw && $folder =~ m!\Aimaps?://!i) {
+               require PublicInbox::URIimap;
+               PublicInbox::URIimap->new($folder)->uidvalidity //
+                       Carp::croak("BUG: $folder has no UIDVALIDITY");
        }
        return unless $rw;
 
@@ -106,7 +111,7 @@ EOM
 
 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;
@@ -123,7 +128,7 @@ INSERT OR IGNORE INTO blob2num (oidbin, fid, uid) VALUES (?, ?, ?)
 
 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;
@@ -141,7 +146,7 @@ DELETE FROM blob2num WHERE fid = ? AND uid = ?
 # 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 = ?
 
@@ -153,7 +158,12 @@ sub each_src {
        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) {
@@ -171,7 +181,7 @@ sub location_stats {
        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 = ?
 
@@ -297,4 +307,95 @@ sub match_imap_url {
                        "E: `$url' is ambiguous:\n\t".join("\n\t", @match)."\n";
 }
 
+# map CLI args to folder table entries, returns undef on failure
+sub arg2folder {
+       my ($self, $lei, $folders) = @_;
+       my @all = $self->folders;
+       my %all = map { $_ => 1 } @all;
+       my ($err, @no);
+       for (@$folders) {
+               next if $all{$_}; # ok
+               if (m!\A(maildir|mh):(.+)!i) {
+                       my $type = lc $1;
+                       my $d = "$type:".$lei->abs_path($2);
+                       push(@no, $_) unless $all{$d};
+                       $_ = $d;
+               } elsif (-d "$_/new" && -d "$_/cur") {
+                       my $d = 'maildir:'.$lei->abs_path($_);
+                       push(@no, $_) unless $all{$d};
+                       $_ = $d;
+               } elsif (m!\Aimaps?://!i) {
+                       my $orig = $_;
+                       my $res = match_imap_url($self, $orig, \@all);
+                       if (ref $res) {
+                               $_ = $$res;
+                               push(@{$err->{qerr}}, <<EOM);
+# using `$res' instead of `$orig'
+EOM
+                       } else {
+                               $lei->err($res) if defined $res;
+                               push @no, $orig;
+                       }
+               } else {
+                       push @no, $_;
+               }
+       }
+       if (@no) {
+               my $no = join("\n\t", @no);
+               $err->{fail} = <<EOF;
+No sync information for: $no
+Run `lei ls-mail-sync' to display valid choices
+EOF
+       }
+       $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);
+}
+
+sub imap_oid2 ($$$) {
+       my ($self, $uri, $uid) = @_; # $uri MUST have UIDVALIDITY
+       my $fid = $self->{fmap}->{"$uri"} //= fid_for($self, "$uri") // return;
+       my $sth = $self->{dbh}->prepare_cached(<<EOM, undef, 1);
+SELECT oidbin FROM blob2num WHERE fid = ? AND uid = ?
+EOM
+       $sth->execute($fid, $uid);
+       my ($oidbin) = $sth->fetchrow_array;
+       $oidbin ? unpack('H*', $oidbin) : undef;
+}
+
+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};
+       }
+       imap_oid2($self, $folders->[0], $uid_uri->uid);
+}
+
+
+# FIXME: something with "lei <up|q>" 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();
+}
+
 1;