lei export-kw: support exporting keywords to IMAP

We support writing to IMAP stores in other places (just like
Maildir), and it's actually less complex for us to write to
IMAP.  Neither usability nor performance is ideal, but usability
will be addressed in the next commit to relax CLI argument
checking.

Performance is poor due to the synchronous Mail::IMAPClient
API and will need to be addressed with pipelining sometime
further in the future.

diff --git a/lib/PublicInbox/LeiExportKw.pm b/lib/PublicInbox/LeiExportKw.pm
index db4f7441d3b753293b51e7a5604e7d98b64fbfb0..5ad339593f2986aea644187829a4f09c1ef7b2db 100644 (file)
--- a/lib/PublicInbox/LeiExportKw.pm
+++ b/lib/PublicInbox/LeiExportKw.pm
@@ -59,15 +59,28 @@ sub export_kw_md { # LeiMailSync->each_src callback
        $self->{lei}->child_error(1, "link($orig, $dst) ($oidhex): $e");
 }
 
+sub export_kw_imap { # LeiMailSync->each_src callback
+       my ($oidbin, $id, $self, $mic) = @_;
+       my $oidhex = unpack('H*', $oidbin);
+       my $sto_kw = $self->{lse}->oid_keywords($oidhex) or return;
+       $self->{imap_mod_kw}->($self->{nwr}, $mic, $id, [ keys %$sto_kw ]);
+}
+
 # overrides PublicInbox::LeiInput::input_path_url
 sub input_path_url {
        my ($self, $input, @args) = @_;
        my $lms = $self->{lms} //= $self->{lse}->lms;
        $lms->lms_begin;
-       if ($input =~ s/\Amaildir://i) {
+       if ($input =~ /\Amaildir:(.+)/i) {
+               my $mdir = $1;
                require PublicInbox::LeiToMail; # kw2suffix
-               $lms->each_src("maildir:$input", \&export_kw_md, $self, $input);
-       }
+               $lms->each_src($input, \&export_kw_md, $self, $mdir);
+       } elsif ($input =~ m!\Aimaps?://!) {
+               my $uri = PublicInbox::URIimap->new($input);
+               my $mic = $self->{nwr}->mic_for_folder($uri);
+               $lms->each_src($$uri, \&export_kw_imap, $self, $mic);
+               $mic->expunge;
+       } else { die "BUG: $input not supported" }
        $lms->lms_commit;
 }
 
@@ -137,11 +150,6 @@ EOF
        if (my @ro = grep(!/\A(?:maildir|imaps?):/, @folders)) {
                return $lei->fail("cannot export to read-only folders: @ro");
        }
-       if (my $net = $lei->{net}) {
-               require PublicInbox::NetWriter;
-               bless $net, 'PublicInbox::NetWriter';
-       }
-       undef $lms;
        my $m = $opt->{mode} // 'merge';
        if ($m eq 'merge') { # default
                $self->{-merge_kw} = 1;
@@ -151,6 +159,13 @@ EOF
 --mode=$m not supported (`set' or `merge')
 EOM
        }
+       if (my $net = $lei->{net}) {
+               require PublicInbox::NetWriter;
+               $self->{nwr} = bless $net, 'PublicInbox::NetWriter';
+               $self->{imap_mod_kw} = $net->can($self->{-merge_kw} ?
+                                       'imap_add_kw' : 'imap_set_kw');
+       }
+       undef $lms;
        my $ops = {};
        $lei->{auth}->op_merge($ops, $self) if $lei->{auth};
        $self->{-wq_nr_workers} = $j // 1; # locked

diff --git a/lib/PublicInbox/LeiToMail.pm b/lib/PublicInbox/LeiToMail.pm
index b9d4c8563fa643c3ac012557bdd6adecc16d4ae6..f3c039699cc26bdd5c539fe6b3acc8ed5a4c70d7 100644 (file)
--- a/lib/PublicInbox/LeiToMail.pm
+++ b/lib/PublicInbox/LeiToMail.pm
@@ -307,11 +307,12 @@ sub _imap_write_cb ($$) {
        my $dedupe = $lei->{dedupe};
        $dedupe->prepare_dedupe if $dedupe;
        my $append = $lei->{net}->can('imap_append');
-       my $mic = $lei->{net}->mic_get($self->{uri});
-       my $folder = $self->{uri}->mailbox;
+       my $uri = $self->{uri};
+       my $mic = $lei->{net}->mic_get($uri);
+       my $folder = $uri->mailbox;
+       $uri->uidvalidity($mic->uidvalidity($folder));
        my $lse = $lei->{lse}; # may be undef
        my $sto = $lei->{opt}->{'mail-sync'} ? $lei->{sto} : undef;
-       my $out = $lei->{ovv}->{dst};
        sub { # for git_to_mail
                my ($bref, $smsg, $eml) = @_;
                $mic // return $lei->fail; # mic may be undef-ed in last run
@@ -327,7 +328,7 @@ sub _imap_write_cb ($$) {
                # imap_append returns UID if IMAP server has UIDPLUS extension
                ($sto && $uid =~ /\A[0-9]+\z/) and
                        $sto->ipc_do('set_sync_info',
-                                       $smsg->{blob}, $out, $uid + 0);
+                                       $smsg->{blob}, $$uri, $uid + 0);
                ++$lei->{-nr_write};
        }
 }

diff --git a/lib/PublicInbox/NetWriter.pm b/lib/PublicInbox/NetWriter.pm
index 2032a1fd22291c55715c170942ff529ca842183c..8ec7f85c876b568cf6102cc9dbdf705203bb2d03 100644 (file)
--- a/lib/PublicInbox/NetWriter.pm
+++ b/lib/PublicInbox/NetWriter.pm
@@ -26,10 +26,20 @@ sub imap_append {
                die "APPEND $folder: $@";
 }
 
+# updates $uri with UIDVALIDITY
 sub mic_for_folder {
        my ($self, $uri) = @_;
        my $mic = $self->mic_get($uri) or die "E: not connected: $@";
        $mic->select($uri->mailbox) or return;
+       my $uidval;
+       for ($mic->Results) {
+               /^\* OK \[UIDVALIDITY ([0-9]+)\].*/ or next;
+               $uidval = $1;
+               last;
+       }
+       $uidval //= $mic->uidvalidity($uri->mailbox) or
+               die "E: failed to get uidvalidity from <$uri>: $@";
+       $uri->uidvalidity($uidval);
        $mic;
 }
 

diff --git a/xt/net_writer-imap.t b/xt/net_writer-imap.t
index 1298b958f683ba5d40404146e8162651736fc087..0e6d483161108e451bfca78a512549b217c6e927 100644 (file)
--- a/xt/net_writer-imap.t
+++ b/xt/net_writer-imap.t
@@ -157,12 +157,20 @@ test_lei(sub {
 
        lei_ok qw(import -F eml), $f, \'import local copy w/o keywords';
 
+       lei_ok 'ls-mail-sync'; diag $lei_out;
+       lei_ok 'import', $$folder_uri; # populate mail_sync.sqlite3
+       lei_ok qw(tag +kw:seen +kw:answered +kw:flagged), $f;
+       lei_ok 'ls-mail-sync'; diag $lei_out;
+       chomp(my $uri_val = $lei_out);
+       lei_ok 'export-kw', $uri_val;
        $mic = $nwr->mic_for_folder($folder_uri);
-       # dummy set to ensure second set_kw clobbers
-       $nwr->imap_set_kw($mic, $uid[0], [ qw(seen answered flagged) ]
-                       )->expunge or BAIL_OUT "expunge $@";
-       $nwr->imap_set_kw($mic, $uid[0], [ 'seen' ]
-                       )->expunge or BAIL_OUT "expunge $@";
+       my $flags = $mic->flags($uid[0]);
+       is_deeply([sort @$flags], [ qw(\\Answered \\Flagged \\Seen) ],
+               'IMAP flags set by export-kw') or diag explain($flags);
+
+       # ensure this imap_set_kw clobbers
+       $nwr->imap_set_kw($mic, $uid[0], [ 'seen' ])->expunge or
+               BAIL_OUT "expunge $@";
        $mic = undef;
        @res = ();
        $nwr->imap_each($folder_uri, $imap_slurp_all, \@res);