lib/PublicInbox/LeiExternal.pm

   1 # Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # *-external commands of lei
   5 package PublicInbox::LeiExternal;
   6 use strict;
   7 use v5.10.1;
   8 use parent qw(Exporter);
   9 our @EXPORT = qw(lei_ls_external lei_add_external lei_forget_external);
  10 use PublicInbox::Config;
  11
  12 sub _externals_each {
  13         my ($self, $cb, @arg) = @_;
  14         my $cfg = $self->_lei_cfg(0);
  15         my %boost;
  16         for my $sec (grep(/\Aexternal\./, @{$cfg->{-section_order}})) {
  17                 my $loc = substr($sec, length('external.'));
  18                 $boost{$loc} = $cfg->{"$sec.boost"};
  19         }
  20         return \%boost if !wantarray && !$cb;
  21
  22         # highest boost first, but stable for alphabetic tie break
  23         use sort 'stable';
  24         my @order = sort { $boost{$b} <=> $boost{$a} } sort keys %boost;
  25         return @order if !$cb;
  26         for my $loc (@order) {
  27                 $cb->(@arg, $loc, $boost{$loc});
  28         }
  29         @order; # scalar or array
  30 }
  31
  32 sub lei_ls_external {
  33         my ($self, @argv) = @_;
  34         my $out = $self->{1};
  35         my ($OFS, $ORS) = $self->{opt}->{z} ? ("\0", "\0\0") : (" ", "\n");
  36         $self->_externals_each(sub {
  37                 my ($loc, $boost_val) = @_;
  38                 print $out $loc, $OFS, 'boost=', $boost_val, $ORS;
  39         });
  40 }
  41
  42 sub _canonicalize {
  43         my ($location) = @_;
  44         if ($location !~ m!\Ahttps?://!) {
  45                 PublicInbox::Config::rel2abs_collapsed($location);
  46         } else {
  47                 require URI;
  48                 my $uri = URI->new($location)->canonical;
  49                 my $path = $uri->path . '/';
  50                 $path =~ tr!/!/!s; # squeeze redundant '/'
  51                 $uri->path($path);
  52                 $uri->as_string;
  53         }
  54 }
  55
  56 sub lei_add_external {
  57         my ($self, $location) = @_;
  58         my $cfg = $self->_lei_cfg(1);
  59         my $new_boost = $self->{opt}->{boost} // 0;
  60         $location = _canonicalize($location);
  61         if ($location !~ m!\Ahttps?://! && !-d $location) {
  62                 return $self->fail("$location not a directory");
  63         }
  64         my $key = "external.$location.boost";
  65         my $cur_boost = $cfg->{$key};
  66         return if defined($cur_boost) && $cur_boost == $new_boost; # idempotent
  67         $self->lei_config($key, $new_boost);
  68         $self->_lei_store(1)->done; # just create the store
  69 }
  70
  71 sub lei_forget_external {
  72         my ($self, @locations) = @_;
  73         my $cfg = $self->_lei_cfg(1);
  74         my $quiet = $self->{opt}->{quiet};
  75         my %seen;
  76         for my $loc (@locations) {
  77                 my (@unset, @not_found);
  78                 for my $l ($loc, _canonicalize($loc)) {
  79                         next if $seen{$l}++;
  80                         my $key = "external.$l.boost";
  81                         delete($cfg->{$key});
  82                         $self->_config('--unset', $key);
  83                         if ($? == 0) {
  84                                 push @unset, $l;
  85                         } elsif (($? >> 8) == 5) {
  86                                 push @not_found, $l;
  87                         } else {
  88                                 $self->err("# --unset $key error");
  89                                 return $self->x_it($?);
  90                         }
  91                 }
  92                 if (@unset) {
  93                         next if $quiet;
  94                         $self->err("# $_ gone") for @unset;
  95                 } elsif (@not_found) {
  96                         $self->err("# $_ not found") for @not_found;
  97                 } # else { already exited
  98         }
  99 }
 100
 101 # shell completion helper called by lei__complete
 102 sub _complete_forget_external {
 103         my ($self, @argv) = @_;
 104         my $cfg = $self->_lei_cfg(0);
 105         my $cur = pop @argv;
 106         # Workaround bash word-splitting URLs to ['https', ':', '//' ...]
 107         # Maybe there's a better way to go about this in
 108         # contrib/completion/lei-completion.bash
 109         my $re = '';
 110         if (@argv) {
 111                 my @x = @argv;
 112                 if ($cur eq ':' && @x) {
 113                         push @x, $cur;
 114                         $cur = '';
 115                 }
 116                 while (@x > 2 && $x[0] !~ /\Ahttps?\z/ && $x[1] ne ':') {
 117                         shift @x;
 118                 }
 119                 if (@x >= 2) { # qw(https : hostname : 443) or qw(http :)
 120                         $re = join('', @x);
 121                 } else { # just filter out the flags and hope for the best
 122                         $re = join('', grep(!/^-/, @argv));
 123                 }
 124                 $re = quotemeta($re);
 125         }
 126         # FIXME: bash completion off "http:" or "https:" when the last
 127         # character is a colon doesn't work properly even if we're
 128         # returning "//$HTTP_HOST/$PATH_INFO/", not sure why, could
 129         # be a bash issue.
 130         map {
 131                 my $x = substr($_, length('external.'));
 132                 # only return the part specified on the CLI
 133                 if ($x =~ /\A$re(\Q$cur\E.*)/) {
 134                         # don't duplicate if already 100% completed
 135                         $cur eq $1 ? () : $1;
 136                 } else {
 137                         ();
 138                 }
 139         } grep(/\Aexternal\.$re\Q$cur/, @{$cfg->{-section_order}});
 140 }
 141
 142 1;