]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/LeiALE.pm
solver: support sha256 coderepos
[public-inbox.git] / lib / PublicInbox / LeiALE.pm
1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # All Locals Ever: track lei/store + externals ever used as
5 # long as they're on an accessible FS.  Includes "lei q" --include
6 # and --only targets that haven't been through "lei add-external".
7 # Typically: ~/.cache/lei/all_locals_ever.git
8 package PublicInbox::LeiALE;
9 use strict;
10 use v5.10.1;
11 use parent qw(PublicInbox::LeiSearch PublicInbox::Lock);
12 use PublicInbox::Git;
13 use PublicInbox::Import;
14 use PublicInbox::LeiXSearch;
15 use Fcntl qw(SEEK_SET);
16
17 sub _new {
18         my ($d) = @_;
19         PublicInbox::Import::init_bare($d, 'ale');
20         bless {
21                 git => PublicInbox::Git->new($d),
22                 lock_path => "$d/lei_ale.state", # dual-duty lock + state
23                 ibxish => [], # Inbox and ExtSearch (and LeiSearch) objects
24         }, __PACKAGE__
25 }
26
27 sub new {
28         my ($self, $lei) = @_;
29         ref($self) or $self = _new($lei->cache_dir . '/all_locals_ever.git');
30         my $lxs = PublicInbox::LeiXSearch->new;
31         my $sto = $lei->_lei_store;
32         $lxs->prepare_external($sto->search) if $sto;
33         for my $loc ($lei->externals_each) { # locals only
34                 $lxs->prepare_external($loc) if -d $loc;
35         }
36         $self->refresh_externals($lxs, $lei);
37         $self;
38 }
39
40 sub over {} # undef for xoids_for
41
42 sub overs_all { # for xoids_for (called only in lei workers?)
43         my ($self) = @_;
44         my $pid = $$;
45         if (($self->{owner_pid} // $pid) != $pid) {
46                 delete($_->{over}) for @{$self->{ibxish}};
47         }
48         $self->{owner_pid} = $pid;
49         grep(defined, map { $_->over } @{$self->{ibxish}});
50 }
51
52 sub refresh_externals {
53         my ($self, $lxs, $lei) = @_;
54         $self->git->cleanup;
55         my $lk = $self->lock_for_scope;
56         my $cur_lxs = ref($lxs)->new;
57         my $orig = do {
58                 local $/;
59                 readline($self->{lockfh}) //
60                                 die "readline($self->{lock_path}): $!";
61         };
62         my $new = '';
63         my $old = '';
64         my $gone = 0;
65         my %seen_ibxish; # $dir => any-defined value
66         for my $dir (split(/\n/, $orig)) {
67                 if (-d $dir && -r _ && $cur_lxs->prepare_external($dir)) {
68                         $seen_ibxish{$dir} //= length($old .= "$dir\n");
69                 } else {
70                         ++$gone;
71                 }
72         }
73         my @ibxish = $cur_lxs->locals;
74         for my $x ($lxs->locals) {
75                 my $d = $lei->canonpath_harder($x->{inboxdir} // $x->{topdir});
76                 $seen_ibxish{$d} //= do {
77                         $new .= "$d\n";
78                         push @ibxish, $x;
79                 };
80         }
81         if ($new ne '' || $gone) {
82                 $self->{lockfh}->autoflush(1);
83                 if ($gone) {
84                         seek($self->{lockfh}, 0, SEEK_SET) or die "seek: $!";
85                         truncate($self->{lockfh}, 0) or die "truncate: $!";
86                 } else {
87                         $old = '';
88                 }
89                 print { $self->{lockfh} } $old, $new or die "print: $!";
90         }
91         $new = $old = '';
92         my $f = $self->git->{git_dir}.'/objects/info/alternates';
93         if (open my $fh, '<', $f) {
94                 local $/;
95                 $old = <$fh> // die "readline($f): $!";
96         }
97         for my $x (@ibxish) {
98                 $new .= $lei->canonpath_harder($x->git->{git_dir})."/objects\n";
99         }
100         $self->{ibxish} = \@ibxish;
101         return if $old eq $new;
102
103         # this needs to be atomic since child processes may start
104         # git-cat-file at any time
105         my $tmp = "$f.$$.tmp";
106         open my $fh, '>', $tmp or die "open($tmp): $!";
107         print $fh $new or die "print($tmp): $!";
108         close $fh or die "close($tmp): $!";
109         rename($tmp, $f) or die "rename($tmp, $f): $!";
110 }
111
112 1;