lei export-kw: new command to export keywords to Maildirs

[public-inbox.git] / lib / PublicInbox / LeiMailSync.pm

diff --git a/lib/PublicInbox/LeiMailSync.pm b/lib/PublicInbox/LeiMailSync.pm
index 52f26d69107374878ac286fdafc5578bd0fc8505..32e17c6576da3c269b4dfbf0c268c65d669401c3 100644 (file)
--- a/lib/PublicInbox/LeiMailSync.pm
+++ b/lib/PublicInbox/LeiMailSync.pm
@@ -6,17 +6,12 @@ package PublicInbox::LeiMailSync;
 use strict;
 use v5.10.1;
 use DBI;
+use PublicInbox::ContentHash qw(git_sha);
 
 sub dbh_new {
        my ($self, $rw) = @_;
        my $f = $self->{filename};
-       my $creat;
-       if (!-f $f && $rw) {
-               require PublicInbox::Spawn;
-               open my $fh, '+>>', $f or die "failed to open $f: $!";
-               PublicInbox::Spawn::nodatacow_fd(fileno($fh));
-               $creat = 1;
-       }
+       my $creat = $rw && !-s $f;
        my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', {
                AutoCommit => 1,
                RaiseError => 1,
@@ -71,15 +66,34 @@ CREATE TABLE IF NOT EXISTS blob2name (
 sub _fid_for {
        my ($self, $folder, $rw) = @_;
        my $dbh = $self->{dbh};
-       my ($row) = $dbh->selectrow_array(<<'', undef, $folder);
-SELECT fid FROM folders WHERE loc = ? LIMIT 1
+       my $sel = 'SELECT fid FROM folders WHERE loc = ? LIMIT 1';
+       my ($fid) = $dbh->selectrow_array($sel, undef, $folder);
+       return $fid if defined $fid;
 
-       return $row if defined $row;
+       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;
+UPDATE folders SET loc = ? WHERE fid = ?
+EOM
+                       return $fid;
+               }
+       # sometimes we stored trailing slash..
+       } elsif ($folder =~ m!\A(?:maildir|mh):!i) {
+               ($fid) = $dbh->selectrow_array($sel, undef, "$folder/");
+               if (defined $fid) {
+                       $dbh->do(<<EOM, undef, $folder, $fid) if $rw;
+UPDATE folders SET loc = ? WHERE fid = ?
+EOM
+                       return $fid;
+               }
+       }
        return unless $rw;
 
-       ($row) = $dbh->selectrow_array('SELECT MAX(fid) FROM folders');
+       ($fid) = $dbh->selectrow_array('SELECT MAX(fid) FROM folders');
 
-       my $fid = ($row // 0) + 1;
+       $fid += 1;
        # in case we're reusing, clobber existing stale refs:
        $dbh->do('DELETE FROM blob2name WHERE fid = ?', undef, $fid);
        $dbh->do('DELETE FROM blob2num WHERE fid = ?', undef, $fid);
@@ -124,6 +138,16 @@ DELETE FROM blob2num WHERE fid = ? AND uid = ?
        $sth->execute($fid, $id);
 }
 
+# Maildir-only
+sub mv_src {
+       my ($self, $folder, $oidbin, $id, $newbn) = @_;
+       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);
+}
+
 # read-only, iterates every oidbin + UID or name for a given folder
 sub each_src {
        my ($self, $folder, $cb, @args) = @_;
@@ -143,7 +167,7 @@ sub each_src {
 }
 
 sub location_stats {
-       my ($self, $folder, $cb, @args) = @_;
+       my ($self, $folder) = @_;
        my $dbh = $self->{dbh} //= dbh_new($self);
        my $fid;
        my $ret = {};
@@ -208,4 +232,37 @@ sub folders {
        map { $_->[0] } @{$dbh->selectall_arrayref($sql, undef, @pfx)};
 }
 
+sub local_blob {
+       my ($self, $oidhex, $vrfy) = @_;
+       my $dbh = $self->{dbh} //= dbh_new($self);
+       my $b2n = $dbh->prepare(<<'');
+SELECT f.loc,b.name FROM blob2name b
+LEFT JOIN folders f ON b.fid = f.fid
+WHERE b.oidbin = ?
+
+       $b2n->execute(pack('H*', $oidhex));
+       while (my ($d, $n) = $b2n->fetchrow_array) {
+               substr($d, 0, length('maildir:')) = '';
+               # n.b. both mbsync and offlineimap use ":2," as a suffix
+               # in "new/", despite (from what I understand of reading
+               # <https://cr.yp.to/proto/maildir.html>), the ":2," only
+               # applies to files in "cur/".
+               my @try = $n =~ /:2,[a-zA-Z]+\z/ ? qw(cur new) : qw(new cur);
+               for my $x (@try) {
+                       my $f = "$d/$x/$n";
+                       open my $fh, '<', $f or next;
+                       # some (buggy) Maildir writers are non-atomic:
+                       next unless -s $fh;
+                       local $/;
+                       my $raw = <$fh>;
+                       if ($vrfy && git_sha(1, \$raw)->hexdigest ne $oidhex) {
+                               warn "$f changed $oidhex\n";
+                               next;
+                       }
+                       return \$raw;
+               }
+       }
+       undef;
+}
+
 1;