Eric Wong (4): lei: completion: fix filename completion lei: automatic pager support lei: use client env as-is, drop daemon-env command address: pairs: new helper for JMAP (and maybe lei) contrib/completion/lei-completion.bash | 2 +- lib/PublicInbox/Address.pm | 11 ++++- lib/PublicInbox/AddressPP.pm | 21 ++++++++ lib/PublicInbox/LEI.pm | 68 +++++++++++++++----------- t/address.t | 33 ++++++++++--- t/lei.t | 30 +----------- 6 files changed, 100 insertions(+), 65 deletions(-)
"-o default" is what we want from "complete", "-o filename" just tells readline the result from the "_lei" function might be a filename and quote appropriately. --- contrib/completion/lei-completion.bash | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/contrib/completion/lei-completion.bash b/contrib/completion/lei-completion.bash index 5f47433b..0b82b109 100644 --- a/contrib/completion/lei-completion.bash +++ b/contrib/completion/lei-completion.bash @@ -8,4 +8,4 @@ _lei() { -- "${COMP_WORDS[COMP_CWORD]}")) return 0 } -complete -o filenames -o bashdefault -F _lei lei +complete -o default -o bashdefault -F _lei lei
Just like git, we'll start a pager when outputting to a terminal for user-friendliness when reading many messages. --- lib/PublicInbox/LEI.pm | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index 9a3b1ee3..6073a713 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -19,7 +19,7 @@ use PublicInbox::Config; use PublicInbox::Syscall qw(SFD_NONBLOCK EPOLLIN EPOLLONESHOT); use PublicInbox::Sigfd; use PublicInbox::DS qw(now dwaitpid); -use PublicInbox::Spawn qw(spawn run_die); +use PublicInbox::Spawn qw(spawn run_die popen_rd); use PublicInbox::OnDestroy; use Text::Wrap qw(wrap); use File::Path qw(mkpath); @@ -619,6 +619,26 @@ sub lei_git { # support passing through random git commands dwaitpid($pid, \&reap_exec, $self); } +# caller needs to "-t $self->{1}" to check if tty +sub start_pager { + my ($self) = @_; + my $env = $self->{env}; + my $fh = popen_rd([qw(git var GIT_PAGER)], $env); + chomp(my $pager = <$fh> // ''); + close($fh) or warn "`git var PAGER' error: \$?=$?"; + return if $pager eq 'cat' || $pager eq ''; + $env->{LESS} //= 'FRX'; + $env->{LV} //= '-c'; + $env->{COLUMNS} //= 80; # TODO TIOCGWINSZ + $env->{MORE} //= 'FRX' if $^O eq 'freebsd'; + pipe(my ($r, $w)) or return warn "pipe: $!"; + my $rdr = { 0 => $r, 1 => $self->{1}, 2 => $self->{2} }; + $self->{1} = $w; + $self->{2} = $w if -t $self->{2}; + $self->{'pager.pid'} = spawn([$pager], $env, $rdr); + $env->{GIT_PAGER_IN_USE} = 'true'; # we may spawn git +} + sub accept_dispatch { # Listener {post_accept} callback my ($sock) = @_; # ignore other $sock->blocking(1); @@ -794,6 +814,12 @@ sub oneshot { # ensures stdout hits the FS before sock disconnects so a client # can immediately reread it -sub DESTROY { $_[0]->{1}->autoflush(1) } +sub DESTROY { + my ($self) = @_; + $self->{1}->autoflush(1); + if (my $pid = delete $self->{'pager.pid'}) { + dwaitpid($pid, undef, $self->{sock}); + } +} 1;
There may be subtle misbehaviours when mixing the existing daemon env and the client-supplied env. Just do the simplest thing and use the client env as-is. We'll also start the ->event_step callback since we'll need to remember some things for long-lived commands. --- lib/PublicInbox/LEI.pm | 38 ++++++++++++-------------------------- t/lei.t | 30 +----------------------------- 2 files changed, 13 insertions(+), 55 deletions(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index 6073a713..9c3308ad 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -149,8 +149,6 @@ our %CMD = ( # sorted in order of importance/use: 'daemon-kill' => [ '[-SIGNAL]', 'signal the lei-daemon', opt_dash('signal|s=s', '[0-9]+|(?:[A-Z][A-Z0-9]+)') ], 'daemon-pid' => [ '', 'show the PID of the lei-daemon' ], -'daemon-env' => [ '[NAME=VALUE...]', 'set, unset, or show daemon environment', - qw(clear| unset|u=s@ z|0) ], 'help' => [ '[SUBCOMMAND]', 'show help' ], # XXX do we need this? @@ -230,12 +228,6 @@ my %OPTDESC = ( # xargs, env, use "-0", git(1) uses "-z". We support z|0 everywhere 'z|0' => 'use NUL \\0 instead of newline (CR) to delimit lines', -# note: no "--ignore-environment" / "-i" support like env(1) since that -# is one-shot and this is for a persistent daemon: -'clear|' => 'clear the daemon environment', -'unset|u=s@' => ['NAME', - 'unset matching NAME, may be specified multiple times'], - 'signal|s=s' => [ 'SIG', 'signal to send lei-daemon (default: TERM)' ], ); # %OPTDESC @@ -538,24 +530,6 @@ sub lei_daemon_kill { kill($sig, $$) or fail($self, "kill($sig, $$): $!"); } -sub lei_daemon_env { - my ($self, @argv) = @_; - my $opt = $self->{opt}; - if (defined $opt->{clear}) { - %ENV = (); - } elsif (my $u = $opt->{unset}) { - delete @ENV{@$u}; - } - if (@argv) { - %ENV = (%ENV, map { split(/=/, $_, 2) } @argv); - } elsif (!defined($opt->{clear}) && !$opt->{unset}) { - my $eor = $opt->{z} ? "\0" : "\n"; - my $buf = ''; - while (my ($k, $v) = each %ENV) { $buf .= "$k=$v$eor" } - out $self, $buf; - } -} - sub lei_help { _help($_[0]) } # Shell completion helper. Used by lei-completion.bash and hopefully @@ -678,6 +652,7 @@ sub accept_dispatch { # Listener {post_accept} callback }; my %env = map { split(/=/, $_, 2) } split(/\0/, $env); if (chdir($env{PWD})) { + local %ENV = %env; $self->{env} = \%env; $self->{pid} = $client_pid; eval { dispatch($self, split(/\]\0\[/, $argv)) }; @@ -687,6 +662,17 @@ sub accept_dispatch { # Listener {post_accept} callback } } +# for long-running results +sub event_step { + my ($self) = @_; + local %ENV = %{$self->{env}}; + eval {}; # TODO + if ($@) { + say { $self->{sock} } $@; + $self->close; # PublicInbox::DS::close + } +} + sub noop {} # lei(1) calls this when it can't connect diff --git a/t/lei.t b/t/lei.t index 5afb8351..6d47e307 100644 --- a/t/lei.t +++ b/t/lei.t @@ -192,7 +192,7 @@ if ($ENV{TEST_LEI_ONESHOT}) { } SKIP: { # real socket - require_mods(qw(Cwd), my $nr = 46); + require_mods(qw(Cwd), my $nr = 105); my $nfd = eval { require IO::FDPass; 1 } // do { require PublicInbox::Spawn; PublicInbox::Spawn->can('send_3fds') ? 3 : undef; @@ -215,34 +215,6 @@ SKIP: { # real socket chomp(my $pid_again = $out); is($pid, $pid_again, 'daemon-pid idempotent'); - ok($lei->(qw(daemon-env -0)), 'show env'); - is($err, '', 'no errors in env dump'); - my @env = split(/\0/, $out); - is(scalar grep(/\AHOME=\Q$home\E\z/, @env), 1, 'env has HOME'); - is(scalar grep(/\AFOO=BAR\z/, @env), 1, 'env has FOO=BAR'); - is(scalar grep(/\AXDG_RUNTIME_DIR=/, @env), 1, 'has XDG_RUNTIME_DIR'); - - ok($lei->(qw(daemon-env -u FOO)), 'unset'); - is($out.$err, '', 'no output for unset'); - ok($lei->(qw(daemon-env -0)), 'show again'); - is($err, '', 'no errors in env dump'); - @env = split(/\0/, $out); - is(scalar grep(/\AFOO=BAR\z/, @env), 0, 'env unset FOO'); - - ok($lei->(qw(daemon-env -u FOO -u HOME -u XDG_RUNTIME_DIR)), - 'unset multiple'); - is($out.$err, '', 'no errors output for unset'); - - ok($lei->(qw(daemon-env -0)), 'show again'); - is($err, '', 'no errors in env dump'); - @env = split(/\0/, $out); - is(scalar grep(/\A(?:HOME|XDG_RUNTIME_DIR)=\z/, @env), 0, 'env unset@'); - - ok($lei->(qw(daemon-env -)), 'clear env'); - is($out.$err, '', 'no output'); - ok($lei->(qw(daemon-env)), 'env is empty'); - is($out, '', 'env cleared'); - ok($lei->(qw(daemon-kill)), 'daemon-kill'); is($out, '', 'no output from daemon-kill'); is($err, '', 'no error from daemon-kill');
Per JMAP RFC 8621 sec 4.1.2.3, we should be able to denote the lack of a phrase/comment corresponding to an email address with a JSON "null" (or Perl `undef'). [ { "name": "James Smythe", "email": "james@example.com" }, { "name": null, "email": "jane@example.com" }, { "name": "John Smith", "email": "john@example.com" } ] The new "pairs" method just returns a 2 dimensional array and the consumer will fill in the field names if necessary (or not). lei(1) may use the two dimensional array as-is for JSON output. --- lib/PublicInbox/Address.pm | 11 ++++++++++- lib/PublicInbox/AddressPP.pm | 21 +++++++++++++++++++++ t/address.t | 33 +++++++++++++++++++++++++++------ 3 files changed, 58 insertions(+), 7 deletions(-) diff --git a/lib/PublicInbox/Address.pm b/lib/PublicInbox/Address.pm index f5af4c23..a090fa43 100644 --- a/lib/PublicInbox/Address.pm +++ b/lib/PublicInbox/Address.pm @@ -2,7 +2,9 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> package PublicInbox::Address; use strict; -use warnings; +use v5.10.1; +use parent 'Exporter'; +our @EXPORT_OK = qw(pairs); sub xs_emails { grep { defined } map { $_->address() } parse_email_addresses($_[0]) @@ -17,11 +19,18 @@ sub xs_names { } parse_email_addresses($_[0]); } +sub xs_pairs { # for JMAP, RFC 8621 section 4.1.2.3 + [ map { # LHS (name) may be undef + [ $_->phrase // $_->comment, $_->address ] + } parse_email_addresses($_[0]) ]; +} + eval { require Email::Address::XS; Email::Address::XS->import(qw(parse_email_addresses)); *emails = \&xs_emails; *names = \&xs_names; + *pairs = \&xs_pairs; }; if ($@) { diff --git a/lib/PublicInbox/AddressPP.pm b/lib/PublicInbox/AddressPP.pm index c04de74b..6a3ae4fe 100644 --- a/lib/PublicInbox/AddressPP.pm +++ b/lib/PublicInbox/AddressPP.pm @@ -13,6 +13,7 @@ sub emails { } sub names { + # split by address and post-address comment my @p = split(/<?([^@<>]+)\@[\w\.\-]+>?\s*(\(.*?\))?(?:,\s*|\z)/, $_[0]); my @ret; @@ -35,4 +36,24 @@ sub names { @ret; } +sub pairs { # for JMAP, RFC 8621 section 4.1.2.3 + my ($s) = @_; + [ map { + my $addr = $_; + if ($s =~ s/\A\s*(.*?)\s*<\Q$addr\E>\s*(.*?)\s*(?:,|\z)// || + $s =~ s/\A\s*(.*?)\s*\Q$addr\E\s*(.*?)\s*(?:,|\z)//) { + my ($phrase, $comment) = ($1, $2); + $phrase =~ tr/\r\n\t / /s; + $phrase =~ s/\A['"\s]*//; + $phrase =~ s/['"\s]*\z//; + $phrase =~ s/\s*<*\s*\z//; + $phrase = undef if $phrase !~ /\S/; + $comment = ($comment =~ /\((.*?)\)/) ? $1 : undef; + [ $phrase // $comment, $addr ] + } else { + (); + } + } emails($s) ]; +} + 1; diff --git a/t/address.t b/t/address.t index 0adcf46d..6aa94628 100644 --- a/t/address.t +++ b/t/address.t @@ -7,26 +7,40 @@ use_ok 'PublicInbox::Address'; sub test_pkg { my ($pkg) = @_; - my $emails = \&{"${pkg}::emails"}; - my $names = \&{"${pkg}::names"}; + my $emails = $pkg->can('emails'); + my $names = $pkg->can('names'); + my $pairs = $pkg->can('pairs'); is_deeply([qw(e@example.com e@example.org)], [$emails->('User <e@example.com>, e@example.org')], 'address extraction works as expected'); + is_deeply($pairs->('User <e@example.com>, e@example.org'), + [[qw(User e@example.com)], [undef, 'e@example.org']], + "pair extraction works ($pkg)"); + is_deeply(['user@example.com'], [$emails->('<user@example.com (Comment)>')], 'comment after domain accepted before >'); + is_deeply($pairs->('<user@example.com (Comment)>'), + [[qw(Comment user@example.com)]], "comment as name ($pkg)"); - my @names = $names->( - 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '. - 'U Ser <u@x> (do not use)'); + my $s = 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '. + 'U Ser <u@x> (do not use)'; + my @names = $names->($s); is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'], 'name extraction works as expected'); + is_deeply($pairs->($s), [ [ 'User', 'e@e' ], [ undef, 'e@e' ], + [ 'John A. Doe', 'j@d' ], [ undef, 'x@x' ], + [ 'xyz', 'y@x' ], [ 'U Ser', 'u@x' ] ], + "pairs extraction works for $pkg"); @names = $names->('"user@example.com" <user@example.com>'); is_deeply(['user'], \@names, 'address-as-name extraction works as expected'); + is_deeply($pairs->('"user@example.com" <user@example.com>'), + [ [ 'user@example.com', 'user@example.com' ] ], + "pairs for $pkg"); { my $backwards = 'u@example.com (John Q. Public)'; @@ -34,10 +48,17 @@ sub test_pkg { is_deeply(\@names, ['John Q. Public'], 'backwards name OK'); my @emails = $emails->($backwards); is_deeply(\@emails, ['u@example.com'], 'backwards emails OK'); + + is_deeply($pairs->($backwards), + [ [ 'John Q. Public', 'u@example.com' ] ], + "backwards pairs $pkg"); } - @names = $names->('"Quote Unneeded" <user@example.com>'); + $s = '"Quote Unneeded" <user@example.com>'; + @names = $names->($s); is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped'); + is_deeply($pairs->($s), [ [ 'Quote Unneeded', 'user@example.com' ] ], + "extra quotes dropped in pairs $pkg"); my @emails = $emails->('Local User <user>'); is_deeply([], \@emails , 'no address for local address');
Eric Wong <e@80x24.org> wrote:
> [
> { "name": "James Smythe", "email": "james@example.com" },
> { "name": null, "email": "jane@example.com" },
> { "name": "John Smith", "email": "john@example.com" }
> ]
I might make JSON the default "lei q" output to the terminal or
pager when no mbox/Maildir/IMAP destination is specified.
Unfortunately, attempting JSON pretty-printing seems to add
excessive vertical white space and I can't easily match the
formatting above. jq(1) can't seem to do what I want, either.
With the Perl JSON modules, the array of 3 hash tables would
either be all on one-line (not human friendly), or have
excessive vertical space:
[
{
"email" : "james@example.com",
"name" : "James Smythe"
},
{
"email" : "jane@example.com",
"name" : null
},
{
"email" : "john@example.com",
"name" : "John Smith"
}
]
So maybe I'll bypass some of the structural/indentation stuff
and only rely on the JSON modules to properly quote strings.
I'm already doing that when outputting search results (similar
to "git log"), just on a per-smsg level to avoid building giant
arrays with 1000K search results in memory all at once.
JSON requiring keys (not just values) to be quoted also annoys
me a bit as being extra visual noise.