X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FLeiMailSync.pm;h=d9b9e117a742b8801f7d9bfb6ff4c3924139c010;hb=0c385e6500f26babc47a0768b730ea38e290a5f5;hp=bf8fb7de1771ebce60dddbccd9288a8751f43985;hpb=21ddb80553ac20b3319069f939667da3d7fba8fe;p=public-inbox.git diff --git a/lib/PublicInbox/LeiMailSync.pm b/lib/PublicInbox/LeiMailSync.pm index bf8fb7de..d9b9e117 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 (); @@ -13,6 +14,11 @@ sub dbh_new { my ($self, $rw) = @_; my $f = $self->{filename}; my $creat = $rw && !-s $f; + if ($creat) { + require PublicInbox::Spawn; + open my $fh, '+>>', $f or Carp::croak "open($f): $!"; + PublicInbox::Spawn::nodatacow_fd(fileno($fh)); + } my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', { AutoCommit => 1, RaiseError => 1, @@ -21,7 +27,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 +35,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 ( @@ -117,8 +132,15 @@ EOM $fid; } +sub add_folders { + my ($self, @folders) = @_; + my $lk = $self->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 @@ -131,11 +153,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 @@ -154,6 +177,7 @@ 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 = ? @@ -171,22 +195,45 @@ INSERT OR IGNORE INTO blob2name (oidbin, fid, name) VALUES (?, ?, ?) 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; } } @@ -200,12 +247,14 @@ sub location_stats { SELECT COUNT(name) FROM blob2name WHERE fid = ? $ret->{'name.count'} = $row if $row; + my $ntype = ($folder =~ m!\A(?:nntps?|s?news)://!i) ? 'article' : + (($folder =~ m!\Aimaps?://!i) ? 'uid' : "TODO<$folder>"); for my $op (qw(count min max)) { ($row) = $dbh->selectrow_array(<<"", undef, $fid); SELECT $op(uid) FROM blob2num WHERE fid = ? $row or last; - $ret->{"uid.$op"} = $row; + $ret->{"$ntype.$op"} = $row; } $ret; } @@ -322,6 +371,30 @@ sub match_imap_url { "E: `$url' is ambiguous:\n\t".join("\n\t", @match)."\n"; } +sub match_nntp_url ($$$) { + my ($self, $url, $all) = @_; # $all = [ $lms->folders ]; + $all //= [ $self->folders ]; + require PublicInbox::URInntps; + my $want = PublicInbox::URInntps->new($url)->canonical; + my ($s, $h, $p) = ($want->scheme, $want->host, $want->port); + my $ng = $want->group; # force scalar (no article ranges) + my @uri = map { PublicInbox::URInntps->new($_)->canonical } + grep(m!\A\Q$s\E://.*?\Q$h\E\b.*?/\Q$ng\E\b!, @$all); + my @match; + for my $x (@uri) { + next if $x->group ne $ng || $x->host ne $h || $x->port != $p; + # maybe user was forgotten on CLI: + if (defined($x->userinfo) && !defined($want->userinfo)) { + push @match, $x; + } elsif (($x->userinfo//"\0") eq ($want->userinfo//"\0")) { + push @match, $x; + } + } + return @match if wantarray; + scalar(@match) <= 1 ? $match[0] : + "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) = @_; @@ -350,9 +423,7 @@ EOM } else { @inc = @all; } - for (@inc) { - push(@$folders, $_) unless $seen{$_}++; - } + push(@$folders, (grep { !$seen{$_}++ } @inc)); } scalar(@$folders) || $lei->fail(<{qerr}}, <err($res) if defined $res; + push @no, $orig; + } + } elsif (m!\A(?:nntps?|s?news)://!i) { + my $orig = $_; + my $res = match_nntp_url($self, $orig, \@all); + if (ref $res) { + $_ = $$res; + push(@{$err->{qerr}}, <err($res) if defined $res; @@ -402,23 +485,41 @@ EOF $err; } -sub forget_folder { - my ($self, $folder) = @_; - my $fid = delete($self->{fmap}->{$folder}) // - fid_for($self, $folder) // return; - for my $t (qw(blob2name blob2num folders)) { - $self->{dbh}->do("DELETE FROM $t 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); + } } } # only used for changing canonicalization errors sub rename_folder { my ($self, $old, $new) = @_; - my $fid = delete($self->{fmap}->{$old}) // + my $lk = $self->lock_for_scope; + my $ofid = delete($self->{fmap}->{$old}) // fid_for($self, $old) // return; - $self->{dbh}->do(<{dbh}->do(<{fmap}->{$new} // fid_for($self, $new); + for my $t (qw(blob2name blob2num)) { + $self->{dbh}->do(<{dbh}->do(<" 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;