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 ($OFS, $ORS) = $self->{opt}->{z} ? ("\0", "\0\0") : (" ", "\n");
  35         $self->_externals_each(sub {
  36                 my ($loc, $boost_val) = @_;
  37                 $self->out($loc, $OFS, 'boost=', $boost_val, $ORS);
  38         });
  39 }
  40
  41 sub _canonicalize {
  42         my ($location) = @_;
  43         if ($location !~ m!\Ahttps?://!) {
  44                 PublicInbox::Config::rel2abs_collapsed($location);
  45         } else {
  46                 require URI;
  47                 my $uri = URI->new($location)->canonical;
  48                 my $path = $uri->path . '/';
  49                 $path =~ tr!/!/!s; # squeeze redundant '/'
  50                 $uri->path($path);
  51                 $uri->as_string;
  52         }
  53 }
  54
  55 sub lei_add_external {
  56         my ($self, $location) = @_;
  57         my $cfg = $self->_lei_cfg(1);
  58         my $new_boost = $self->{opt}->{boost} // 0;
  59         $location = _canonicalize($location);
  60         if ($location !~ m!\Ahttps?://! && !-d $location) {
  61                 return $self->fail("$location not a directory");
  62         }
  63         my $key = "external.$location.boost";
  64         my $cur_boost = $cfg->{$key};
  65         return if defined($cur_boost) && $cur_boost == $new_boost; # idempotent
  66         $self->lei_config($key, $new_boost);
  67         $self->_lei_store(1)->done; # just create the store
  68 }
  69
  70 sub lei_forget_external {
  71         my ($self, @locations) = @_;
  72         my $cfg = $self->_lei_cfg(1);
  73         my $quiet = $self->{opt}->{quiet};
  74         my %seen;
  75         for my $loc (@locations) {
  76                 my (@unset, @not_found);
  77                 for my $l ($loc, _canonicalize($loc)) {
  78                         next if $seen{$l}++;
  79                         my $key = "external.$l.boost";
  80                         delete($cfg->{$key});
  81                         $self->_config('--unset', $key);
  82                         if ($? == 0) {
  83                                 push @unset, $l;
  84                         } elsif (($? >> 8) == 5) {
  85                                 push @not_found, $l;
  86                         } else {
  87                                 $self->err("# --unset $key error");
  88                                 return $self->x_it($?);
  89                         }
  90                 }
  91                 if (@unset) {
  92                         next if $quiet;
  93                         $self->err("# $_ gone") for @unset;
  94                 } elsif (@not_found) {
  95                         $self->err("# $_ not found") for @not_found;
  96                 } # else { already exited
  97         }
  98 }
  99
 100 # shell completion helper called by lei__complete
 101 sub _complete_forget_external {
 102         my ($self, @argv) = @_;
 103         my $cfg = $self->_lei_cfg(0);
 104         my $cur = pop @argv;
 105         # Workaround bash word-splitting URLs to ['https', ':', '//' ...]
 106         # Maybe there's a better way to go about this in
 107         # contrib/completion/lei-completion.bash
 108         my $re = '';
 109         if (@argv) {
 110                 my @x = @argv;
 111                 if ($cur eq ':' && @x) {
 112                         push @x, $cur;
 113                         $cur = '';
 114                 }
 115                 while (@x > 2 && $x[0] !~ /\Ahttps?\z/ && $x[1] ne ':') {
 116                         shift @x;
 117                 }
 118                 if (@x >= 2) { # qw(https : hostname : 443) or qw(http :)
 119                         $re = join('', @x);
 120                 } else { # just filter out the flags and hope for the best
 121                         $re = join('', grep(!/^-/, @argv));
 122                 }
 123                 $re = quotemeta($re);
 124         }
 125         # FIXME: bash completion off "http:" or "https:" when the last
 126         # character is a colon doesn't work properly even if we're
 127         # returning "//$HTTP_HOST/$PATH_INFO/", not sure why, could
 128         # be a bash issue.
 129         map {
 130                 my $x = substr($_, length('external.'));
 131                 # only return the part specified on the CLI
 132                 if ($x =~ /\A$re(\Q$cur\E.*)/) {
 133                         # don't duplicate if already 100% completed
 134                         $cur eq $1 ? () : $1;
 135                 } else {
 136                         ();
 137                 }
 138         } grep(/\Aexternal\.$re\Q$cur/, @{$cfg->{-section_order}});
 139 }
 140
 141 1;