]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LEI.pm
lei: complete option switch args
[public-inbox.git] / lib / PublicInbox / LEI.pm
index 09eac58c8a8592a90d4bad778001d3bef2489da8..d5d9cf1f85ab86f8dec3ae111359ca12c02b403c 100644 (file)
@@ -13,6 +13,7 @@ use parent qw(PublicInbox::DS PublicInbox::LeiExternal
 use Getopt::Long ();
 use Socket qw(AF_UNIX SOCK_SEQPACKET MSG_EOR pack_sockaddr_un);
 use Errno qw(EAGAIN EINTR ECONNREFUSED ENOENT ECONNRESET);
+use Cwd qw(getcwd);
 use POSIX ();
 use IO::Handle ();
 use Fcntl qw(SEEK_SET);
@@ -24,6 +25,7 @@ use PublicInbox::DS qw(now dwaitpid);
 use PublicInbox::Spawn qw(spawn popen_rd);
 use PublicInbox::OnDestroy;
 use Text::Wrap qw(wrap);
+use Time::HiRes qw(stat); # ctime comparisons for config cache
 use File::Path qw(mkpath);
 use File::Spec;
 our $quit = \&CORE::exit;
@@ -64,18 +66,37 @@ sub opt_dash ($$) {
        ($spec, '<>' => $cb, $GLP_PASS) # for Getopt::Long
 }
 
+sub rel2abs ($$) {
+       my ($self, $p) = @_;
+       return $p if index($p, '/') == 0; # already absolute
+       my $pwd = $self->{env}->{PWD};
+       if (defined $pwd) {
+               my $cwd = $self->{3} // getcwd() // die "getcwd(PWD=$pwd): $!";
+               if (my @st_pwd = stat($pwd)) {
+                       my @st_cwd = stat($cwd) or die "stat($cwd): $!";
+                       "@st_pwd[1,0]" eq "@st_cwd[1,0]" or
+                               $self->{env}->{PWD} = $pwd = $cwd;
+               } else { # PWD was invalid
+                       delete $self->{env}->{PWD};
+                       undef $pwd;
+               }
+       }
+       $pwd //= $self->{env}->{PWD} = getcwd() // die "getcwd(PWD=$pwd): $!";
+       File::Spec->rel2abs($p, $pwd);
+}
+
 sub _store_path ($) {
-       my ($env) = @_;
-       File::Spec->rel2abs(($env->{XDG_DATA_HOME} //
-               ($env->{HOME} // '/nonexistent').'/.local/share')
-               .'/lei/store', $env->{PWD});
+       my ($self) = @_;
+       rel2abs($self, ($self->{env}->{XDG_DATA_HOME} //
+               ($self->{env}->{HOME} // '/nonexistent').'/.local/share')
+               .'/lei/store');
 }
 
 sub _config_path ($) {
-       my ($env) = @_;
-       File::Spec->rel2abs(($env->{XDG_CONFIG_HOME} //
-               ($env->{HOME} // '/nonexistent').'/.config')
-               .'/lei/config', $env->{PWD});
+       my ($self) = @_;
+       rel2abs($self, ($self->{env}->{XDG_CONFIG_HOME} //
+               ($self->{env}->{HOME} // '/nonexistent').'/.config')
+               .'/lei/config');
 }
 
 # TODO: generate shell completion + help using %CMD and %OPTDESC
@@ -83,8 +104,9 @@ sub _config_path ($) {
 our %CMD = ( # sorted in order of importance/use:
 'q' => [ 'SEARCH_TERMS...', 'search for messages matching terms', qw(
        save-as=s output|mfolder|o=s format|f=s dedupe|d=s thread|t augment|a
-       sort|s=s reverse|r offset=i remote! local! external! pretty mua-cmd=s
-       torsocks=s no-torsocks verbose|v since|after=s until|before=s),
+       sort|s=s reverse|r offset=i remote! local! external! pretty
+       mua-cmd|mua=s no-torsocks torsocks=s verbose|v
+       received-after=s received-before=s sent-after=s sent-since=s),
        PublicInbox::LeiQuery::curl_opt(), opt_dash('limit|n=i', '[0-9]+') ],
 
 'show' => [ 'MID|OID', 'show a given object (Message-ID or object ID)',
@@ -179,7 +201,11 @@ my $ls_format = [ 'OUT|plain|json|null', 'listing output format' ];
 my %OPTDESC = (
 'help|h' => 'show this built-in help',
 'quiet|q' => 'be quiet',
+'verbose|v' => 'be more verbose',
 'solve!' => 'do not attempt to reconstruct blobs from emails',
+'torsocks=s' => ['auto|no|yes',
+               'whether or not to wrap git and curl commands with torsocks'],
+'no-torsocks' => 'alias for --torsocks=no',
 'save-as=s' => ['NAME', 'save a search terms by given name'],
 
 'type=s' => [ 'any|mid|git', 'disambiguate type' ],
@@ -191,7 +217,7 @@ my %OPTDESC = (
        'return all messages in the same thread as the actual match(es)',
 'augment|a' => 'augment --output destination instead of clobbering',
 
-'output|o=s' => [ 'DEST',
+'output|mfolder|o=s' => [ 'DEST',
        "destination (e.g. `/path/to/Maildir', or `-' for stdout)" ],
 'mua-cmd|mua=s' => [ 'COMMAND',
        "MUA to run on --output Maildir or mbox (e.g. `mutt -f %f'" ],
@@ -201,7 +227,7 @@ my %OPTDESC = (
 'mark  format|f=s' => $stdin_formats,
 'forget        format|f=s' => $stdin_formats,
 'q     format|f=s' => [
-       'OUT|maildir|mboxrd|mboxcl2|mboxcl|html|json|jsonl|concatjson',
+       'OUT|maildir|mboxrd|mboxcl2|mboxcl|mboxo|html|json|jsonl|concatjson',
                'specify output format, default depends on --output'],
 'ls-query      format|f=s' => $ls_format,
 'ls-external   format|f=s' => $ls_format,
@@ -294,7 +320,7 @@ sub atfork_prepare_wq {
        my ($self, $wq) = @_;
        my $tcafc = $wq->{-ipc_atfork_child_close} //= [ $listener // () ];
        if (my $sock = $self->{sock}) {
-               push @$tcafc, @$self{qw(0 1 2)}, $sock;
+               push @$tcafc, @$self{qw(0 1 2 3)}, $sock;
        }
        if (my $pgr = $self->{pgr}) {
                push @$tcafc, @$pgr[1,2];
@@ -344,7 +370,7 @@ sub atfork_parent_wq {
                $ret->{dedupe} = $wq->deep_clone($dedupe);
        }
        $self->{env} = $env;
-       delete @$ret{qw(-lei_store cfg old_1 pgr lxs)}; # keep l2m
+       delete @$ret{qw(-lei_store cfg old_1 pgr lxs)}; # keep l2m
        my @io = delete @$ret{0..2};
        $io[3] = delete($ret->{sock}) // $io[2];
        my $l2m = $ret->{l2m};
@@ -361,7 +387,7 @@ sub _help ($;$) {
        my @info = @{$CMD{$cmd} // [ '...', '...' ]};
        my @top = ($cmd, shift(@info) // ());
        my $cmd_desc = shift(@info);
-       $cmd_desc = $cmd_desc->($self->{env}) if ref($cmd_desc) eq 'CODE';
+       $cmd_desc = $cmd_desc->($self) if ref($cmd_desc) eq 'CODE';
        my @opt_desc;
        my $lpad = 2;
        for my $sw (grep { !ref } @info) { # ("prio=s", "z", $GLP_PASS)
@@ -519,7 +545,7 @@ sub dispatch {
 
 sub _lei_cfg ($;$) {
        my ($self, $creat) = @_;
-       my $f = _config_path($self->{env});
+       my $f = _config_path($self);
        my @st = stat($f);
        my $cur_st = @st ? pack('dd', $st[10], $st[7]) : ''; # 10:ctime, 7:size
        if (my $cfg = $PATH2CFG{$f}) { # reuse existing object in common case
@@ -549,8 +575,7 @@ sub _lei_store ($;$) {
        $cfg->{-lei_store} //= do {
                require PublicInbox::LeiStore;
                my $dir = $cfg->{'leistore.dir'};
-               $dir //= _store_path($self->{env}) if $creat;
-               return unless $dir;
+               $dir //= $creat ? _store_path($self) : return;
                PublicInbox::LeiStore->new($dir, { creat => $creat });
        };
 }
@@ -586,9 +611,8 @@ sub lei_init {
        my ($self, $dir) = @_;
        my $cfg = _lei_cfg($self, 1);
        my $cur = $cfg->{'leistore.dir'};
-       my $env = $self->{env};
-       $dir //= _store_path($env);
-       $dir = File::Spec->rel2abs($dir, $env->{PWD}); # PWD is symlink-aware
+       $dir //= _store_path($self);
+       $dir = rel2abs($self, $dir);
        my @cur = stat($cur) if defined($cur);
        $cur = File::Spec->canonpath($cur // $dir);
        my @dir = stat($dir);
@@ -600,7 +624,7 @@ sub lei_init {
                }
 
                # some folks like symlinks and bind mounts :P
-               if (@dir && "$cur[0] $cur[1]" eq "$dir[0] $dir[1]") {
+               if (@dir && "@cur[1,0]" eq "@dir[1,0]") {
                        lei_config($self, 'leistore.dir', $dir);
                        _lei_store($self, 1)->done;
                        return qerr($self, "$exists (as $cur)");
@@ -654,22 +678,33 @@ sub lei__complete {
                                get-color-name get-colorbool);
                        # fall-through
                }
-               # TODO: arg support
                puts $self, grep(/$re/, map { # generate short/long names
-                       my $eq = '';
-                       if (s/=.+\z//) { # required arg, e.g. output|o=i
-                               $eq = '=';
-                       } elsif (s/:.+\z//) { # optional arg, e.g. mid:s
+                       if (s/[:=].+\z//) { # req/optional args, e.g output|o=i
                        } else { # negation: solve! => no-solve|solve
                                s/\A(.+)!\z/no-$1|$1/;
                        }
                        map {
-                               length > 1 ? "--$_$eq" : "-$_"
+                               my $x = length > 1 ? "--$_" : "-$_";
+                               $x eq $cur ? () : $x;
                        } split(/\|/, $_, -1) # help|h
                } grep { $OPTDESC{"$cmd\t$_"} || $OPTDESC{$_} } @spec);
        } elsif ($cmd eq 'config' && !@argv && !$CONFIG_KEYS{$cur}) {
                puts $self, grep(/$re/, keys %CONFIG_KEYS);
        }
+
+       # switch args (e.g. lei q -f mbox<TAB>)
+       if (($argv[-1] // $cur // '') =~ /\A--?([\w\-]+)\z/) {
+               my $opt = quotemeta $1;
+               puts $self, map {
+                       my $v = $OPTDESC{$_};
+                       $v = $v->[0] if ref($v);
+                       my @v = split(/\|/, $v);
+                       # get rid of ALL CAPS placeholder (e.g "OUT")
+                       # (TODO: completion for external paths)
+                       shift(@v) if uc($v[0]) eq $v[0];
+                       @v;
+               } grep(/\A(?:$cmd\t|)(?:[\w-]+\|)*$opt\b/, keys %OPTDESC);
+       }
        $cmd =~ tr/-/_/;
        if (my $sub = $self->can("_complete_$cmd")) {
                puts $self, $sub->($self, @argv, $cur);
@@ -678,18 +713,6 @@ sub lei__complete {
        # proto parsing.
 }
 
-sub reap_exec { # dwaitpid callback
-       my ($self, $pid) = @_;
-       x_it($self, $?);
-}
-
-sub lei_git { # support passing through random git commands
-       my ($self, @argv) = @_;
-       my %rdr = map { $_ => $self->{$_} } (0..2);
-       my $pid = spawn(['git', @argv], $self->{env}, \%rdr);
-       dwaitpid($pid, \&reap_exec, $self);
-}
-
 sub exec_buf ($$) {
        my ($argv, $env) = @_;
        my $argc = scalar @$argv;
@@ -776,13 +799,13 @@ sub accept_dispatch { # Listener {post_accept} callback
        }
        $self->{2}->autoflush(1); # keep stdout buffered until x_it|DESTROY
        # $ENV_STR = join('', map { "\0$_=$ENV{$_}" } keys %ENV);
-       # $buf = "$$\0$argc\0".join("\0", @ARGV).$ENV_STR."\0\0";
+       # $buf = "$argc\0".join("\0", @ARGV).$ENV_STR."\0\0";
        substr($buf, -2, 2, '') eq "\0\0" or  # s/\0\0\z//
                return send($sock, 'request command truncated', MSG_EOR);
        my ($argc, @argv) = split(/\0/, $buf, -1);
        undef $buf;
        my %env = map { split(/=/, $_, 2) } splice(@argv, $argc);
-       if (chdir(delete($self->{3}))) {
+       if (chdir($self->{3})) {
                local %ENV = %env;
                $self->{env} = \%env;
                eval { dispatch($self, @argv) };