lib/PublicInbox/LeiHelp.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 # -h/--help support for lei
   5 package PublicInbox::LeiHelp;
   6 use strict;
   7 use v5.10.1;
   8 use Text::Wrap qw(wrap);
   9
  10 my %NOHELP = map { $_ => 1 } qw(mfolder);
  11
  12 sub call {
  13         my ($self, $errmsg, $CMD, $OPTDESC) = @_;
  14         my $cmd = $self->{cmd} // 'COMMAND';
  15         my @info = @{$CMD->{$cmd} // [ '...', '...' ]};
  16         my @top = ($cmd, shift(@info) // ());
  17         my $cmd_desc = shift(@info);
  18         $cmd_desc = $cmd_desc->($self) if ref($cmd_desc) eq 'CODE';
  19         $cmd_desc =~ s/default: /default:\xa0/;
  20         my @opt_desc;
  21         my $lpad = 2;
  22         for my $sw (grep { !ref } @info) { # ("prio=s", "z", $GLP_PASS)
  23                 my $desc = $OPTDESC->{"$sw\t$cmd"} // $OPTDESC->{$sw} // next;
  24                 my $arg_vals = '';
  25                 ($arg_vals, $desc) = @$desc if ref($desc) eq 'ARRAY';
  26
  27                 # lower-case is a keyword (e.g. `content', `oid'),
  28                 # ALL_CAPS is a string description (e.g. `PATH')
  29                 if ($desc !~ /default/ && $arg_vals =~ /\b([a-z]+)[,\|]/) {
  30                         $desc .= " (default:\xa0`$1')";
  31                 } else {
  32                         $desc =~ s/default: /default:\xa0/;
  33                 }
  34                 my (@vals, @s, @l);
  35                 my $x = $sw;
  36                 if ($x =~ s/!\z//) { # solve! => --no-solve
  37                         $x =~ s/(\A|\|)/$1no-/g
  38                 } elsif ($x =~ s/\+\z//) { # verbose|v+
  39                 } elsif ($x =~ s/:.+//) { # optional args: $x = "mid:s"
  40                         @vals = (' [', undef, ']');
  41                 } elsif ($x =~ s/=.+//) { # required arg: $x = "type=s"
  42                         @vals = (' ', undef);
  43                 } # else: no args $x = 'threads|t'
  44
  45                 # we support underscore options from public-inbox-* commands;
  46                 # but they've never been documented and will likely go away.
  47                 # $x = help|h
  48                 for (grep { !/_/ && !$NOHELP{$_} } split(/\|/, $x)) {
  49                         length($_) > 1 ? push(@l, "--$_") : push(@s, "-$_");
  50                 }
  51                 if (!scalar(@vals)) { # no args 'threads|t'
  52                 } elsif ($arg_vals =~ s/\A([A-Z_=]+)\b//) { # "NAME"
  53                         $vals[1] = $1;
  54                 } else {
  55                         $vals[1] = uc(substr($l[0], 2)); # "--type" => "TYPE"
  56                 }
  57                 if ($arg_vals =~ /([,\|])/) {
  58                         my $sep = $1;
  59                         my @allow = split(/\Q$sep\E/, $arg_vals);
  60                         my $must = $sep eq '|' ? 'Must' : 'Can';
  61                         @allow = map { length $_ ? "`$_'" : () } @allow;
  62                         my $last = pop @allow;
  63                         $desc .= "\n$must be one of: " .
  64                                 join(', ', @allow) . " or $last";
  65                 }
  66                 my $lhs = join(', ', @s, @l) . join('', @vals);
  67                 if ($x =~ /\|\z/) { # "stdin|" or "clear|"
  68                         $lhs =~ s/\A--/- , --/;
  69                 } else {
  70                         $lhs =~ s/\A--/    --/; # pad if no short options
  71                 }
  72                 $lpad = length($lhs) if length($lhs) > $lpad;
  73                 push @opt_desc, $lhs, $desc;
  74         }
  75         my $msg = $errmsg ? "E: $errmsg\n" : '';
  76         $msg .= <<EOF;
  77 usage: lei @top
  78 $cmd_desc
  79
  80 EOF
  81         $lpad += 2;
  82         local $Text::Wrap::columns = 78 - $lpad;
  83         # local $Text::Wrap::break = ; # don't break on nbsp (\xa0)
  84         my $padding = ' ' x ($lpad + 2);
  85         while (my ($lhs, $rhs) = splice(@opt_desc, 0, 2)) {
  86                 $msg .= '  '.pack("A$lpad", $lhs);
  87                 $rhs = wrap('', '', $rhs);
  88                 $rhs =~ s/\n/\n$padding/sg; # LHS pad continuation lines
  89                 $msg .= $rhs;
  90                 $msg .= "\n";
  91         }
  92         my $fd = $errmsg ? 2 : 1;
  93         $self->start_pager if -t $self->{$fd};
  94         $msg =~ s/\xa0/ /gs; # convert NBSP to SP
  95         print { $self->{$fd} } $msg;
  96         $self->x_it($errmsg ? (1 << 8) : 0); # stderr => failure
  97         undef;
  98 }
  99
 100 # the "lei help" command
 101 sub lei_help { $_[0]->_help }
 102
 103 1;