lib/PublicInbox/Admin.pm

   1 # Copyright (C) 2019 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # common stuff for administrative command-line tools
   5 # Unstable internal API
   6 package PublicInbox::Admin;
   7 use strict;
   8 use warnings;
   9 use Cwd 'abs_path';
  10 use base qw(Exporter);
  11 our @EXPORT_OK = qw(resolve_repo_dir);
  12
  13 sub resolve_repo_dir {
  14         my ($cd, $ver) = @_;
  15         my $prefix = defined $cd ? $cd : './';
  16         if (-d $prefix && -f "$prefix/inbox.lock") { # v2
  17                 $$ver = 2 if $ver;
  18                 return abs_path($prefix);
  19         }
  20
  21         my @cmd = qw(git rev-parse --git-dir);
  22         my $cmd = join(' ', @cmd);
  23         my $pid = open my $fh, '-|';
  24         defined $pid or die "forking $cmd failed: $!\n";
  25         if ($pid == 0) {
  26                 if (defined $cd) {
  27                         chdir $cd or die "chdir $cd failed: $!\n";
  28                 }
  29                 exec @cmd;
  30                 die "Failed to exec $cmd: $!\n";
  31         } else {
  32                 my $dir = eval {
  33                         local $/;
  34                         <$fh>;
  35                 };
  36                 close $fh or die "error in $cmd: $!\n";
  37                 chomp $dir;
  38                 $$ver = 1 if $ver;
  39                 return abs_path($cd) if ($dir eq '.' && defined $cd);
  40                 abs_path($dir);
  41         }
  42 }
  43
  44 # TODO: make Devel::Peek optional, only used for daemon
  45 my @base_mod = qw(Email::MIME Date::Parse Devel::Peek);
  46 my @over_mod = qw(DBD::SQLite DBI);
  47 my %mod_groups = (
  48         -index => [ @base_mod, @over_mod ],
  49         -base => \@base_mod,
  50         -search => [ @base_mod, @over_mod, 'Search::Xapian' ],
  51 );
  52
  53 sub scan_ibx_modules ($$) {
  54         my ($mods, $ibx) = @_;
  55         if (!$ibx->{indexlevel} || $ibx->{indexlevel} ne 'basic') {
  56                 $mods->{'Search::Xapian'} = 1;
  57         } else {
  58                 $mods->{$_} = 1 foreach @over_mod;
  59         }
  60 }
  61
  62 sub check_require {
  63         my (@mods) = @_;
  64         my $err = {};
  65         while (my $mod = shift @mods) {
  66                 if (my $groups = $mod_groups{$mod}) {
  67                         push @mods, @$groups;
  68                 } else {
  69                         eval "require $mod";
  70                         $err->{$mod} = $@ if $@;
  71                 }
  72         }
  73         scalar keys %$err ? $err : undef;
  74 }
  75
  76 sub missing_mod_msg {
  77         my ($err) = @_;
  78         my @mods = map { "`$_'" } sort keys %$err;
  79         my $last = pop @mods;
  80         @mods ? (join(', ', @mods)."' and $last") : $last
  81 }
  82
  83 sub require_or_die {
  84         my $err = check_require(@_) or return;
  85         die missing_mod_msg($err)." required for $0\n";
  86 }
  87
  88 sub indexlevel_ok_or_die ($) {
  89         my ($indexlevel) = @_;
  90         my $req;
  91         if ($indexlevel eq 'basic') {
  92                 $req = '-index';
  93         } elsif ($indexlevel =~ /\A(?:medium|full)\z/) {
  94                 $req = '-search';
  95         } else {
  96                 die <<"";
  97 invalid indexlevel=$indexlevel (must be `basic', `medium', or `full')
  98
  99         }
 100         my $err = check_require($req) or return;
 101         die missing_mod_msg($err) ." required for indexlevel=$indexlevel\n";
 102 }
 103
 104 1;