NPO-Accounting/beancount-tools-in-Perl
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switch from IPC::Run to Expect module; set PAGER to /usr/bin/cat

Browse source 
After some efforts to make this current incarnation of the daemon
work for situations with excessively long output, I discovered two
problems.

First, bean-query seems to always use a pager in interactive mode,
and it seems impossible to dissuade bean-query from this behavior
without an upstream change to Beancount.  As such, my first effort
was to force the pager to be `/usr/bin/cat`, which I thought would be
sufficient to solve the problem entirely.

After that change coupled with much debugging with IPC::Run, I found
that detecting the beancount> prompt using a regular expression of
/^\s*beancount\s*\>\s*/m, or similar efforts with simply
/\s*beancount\s*/ or other versions like /\s*beancount\s*\>\s*$/ms
/\s*beancount\s*\>\s*$/s, simply would not detect the end of the
string, so the process hung on this line in the main loop:

    pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;

Ironically, when there is *not* copious output, that line worked just
fine.  It was baffling.

I switched to Expect, and found the exact same behavior with:

    $runningBeanQuery->expect(undef, -re => '^\s*beancount\s*\>\s*')

with that line, it works fine in the StartRunningBeanQuery()
subroutine, but when used in the main loop, Expect never finds that
string.  Again, I tried it with various regexes as specified above to
no avail.

*However*, merely changing the line to:

    $runningBeanQuery->expect(undef, 'beancount>')

(i.e., not using the regex feature in the Expect library), fixed the
problem entirely.

My working theory is some complex interaction bug between the IO::Pty
module, regular expression matching, and output timing (since this
problem only shows up when there is copious output).  I think in
particular the fact that bean-query creates a subprocess for the
`PAGER` command in the pty when the output is copious is somehow
related to the problem.

Regardless, this solution now works in all the cases where I'm using
the daemon, so I'm not investigating further.
This commit is contained in:
Bradley M. Kuhn 2020-08-17 08:46:57 -07:00
parent 381dff4cb0
commit d6914c481c
No known key found for this signature in database
GPG key ID: F15E8BD6D05E26B3
1 changed files with 19 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
bean-query-goofy-daemon.plx
View file

@ -13,8 +13,11 @@ use File::Temp qw/:mktemp/;
use POSIX qw(mkfifo);
use IPC::Shareable;
use IPC::Run qw(start pump finish timeout);
use Expect;
# We have to set the PAGER to a passthrough text program to assure that
# output does not get paused
$ENV{PAGER} = "/usr/bin/cat";
my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query";
@ -71,7 +74,7 @@ my %beancountData;
tie %beancountData, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed\n";
my ($currentFormat, $runningBeanQuery, $rbcIn, $rbcOut, $rbcErr);
my ($currentFormat, $runningBeanQuery);
sub StartRunningBeanQuery {
my($format) = @_;
@ -81,8 +84,14 @@ sub StartRunningBeanQuery {
my @cmd = ($BEANCOUNT_QUERY_CMD);
push(@cmd, '-f', $format) if defined $format;
push(@cmd, $LOAD_FILE);
$runningBeanQuery = start \@cmd, '<pty<', \$rbcIn, '>pty>', \$rbcOut, '2>', \$rbcErr;
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
$runningBeanQuery = Expect->spawn(@cmd);
$runningBeanQuery->log_stdout(0);
$runningBeanQuery->expect(undef, -re => '^\s*beancount\s*\>\s*')
or die("Unable to find beancount prompt, output was instead: ".
$runningBeanQuery->before() . $runningBeanQuery->after());
print STDERR "Beancount started with output of:\n", $runningBeanQuery->before(),
$runningBeanQuery->match(), $runningBeanQuery->after(), "\n"
if ($VERBOSE > 3);
}
StartRunningBeanQuery('text');
@ -123,12 +132,13 @@ while (1) {
next;
}
print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0;
$rbcOut = "";
$rbcErr = "";
my $ques = $query{question};
$ques =~ s/\n/ /gm;
$rbcIn = "$ques\n";
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
$runningBeanQuery->send("$ques\n");
$runningBeanQuery->expect(undef, 'beancount>') # *Don't* use regex here!
# See `git annotate` on this line for why no regex.
or die("Unable to find beancount prompt, output was instead: ".
$runningBeanQuery->before() . $runningBeanQuery->after());
(tied %query)->shlock;
print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 1;
$query{fifoName} = undef;
@ -142,6 +152,7 @@ while (1) {
open(my $fifoFH, ">", $fifoFileName);
print STDERR "and beginning write to it." if $VERBOSE > 1;
my($seenSeperator, $prevLine) = (0, "");
my $rbcOut = $runningBeanQuery->before();
foreach my $line (split /\n/, $rbcOut) {
# Occasionally, some of the SELECT statement is printed back to
# $rbcOut. Avoid reproducing this in output by waiting for the line
@ -161,8 +172,6 @@ while (1) {
$prevLine = $line;
}
close $fifoFH;
$rbcOut = "";
$rbcIn = "";
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
}