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

Handle repeat of query into STDOUT via pty interface to bean-query

Browse source 
Part of the SELECT statement that was entered gets repeated in the
output.  It's some sort of timing issue with IPC::Run or the IO::Pty
because it's often not the entire input but only part of it.

It does however appear that there is usually a blank line right
before output, and in text mode, we can also search for the line of
-'s as a backup to assure we get the proper output and don't send the
garbled input back as the output across the named pipe.

This is a bit of a hacky solution and likely error-prone.
This commit is contained in:
Bradley M. Kuhn 2020-08-10 07:35:32 -07:00
parent 9f9b110c1d
commit d3395dba78
No known key found for this signature in database
GPG key ID: F15E8BD6D05E26B3
1 changed files with 30 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -71,7 +71,7 @@ my %beancountData;
tie %beancountData, 'IPC::Shareable', $glue, { %options } or tie %beancountData, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed\n"; die "server: tie failed\n";
my ($currentFormat, $runningBeanQuery, $rbcIn, $rbcOut); my ($currentFormat, $runningBeanQuery, $rbcIn, $rbcOut, $rbcErr);
sub StartRunningBeanQuery { sub StartRunningBeanQuery {
my($format) = @_; my($format) = @_;
@ -81,7 +81,7 @@ sub StartRunningBeanQuery {
my @cmd = ($BEANCOUNT_QUERY_CMD); my @cmd = ($BEANCOUNT_QUERY_CMD);
push(@cmd, '-f', $query{format}) if defined $query{format}; push(@cmd, '-f', $query{format}) if defined $query{format};
push(@cmd, $LOAD_FILE); push(@cmd, $LOAD_FILE);
$runningBeanQuery = start \@cmd, '<pty<', \$rbcIn, '>pty>', \$rbcOut; $runningBeanQuery = start \@cmd, '<pty<', \$rbcIn, '>pty>', \$rbcOut, '2>', \$rbcErr;
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m; pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
} }
StartRunningBeanQuery('text'); StartRunningBeanQuery('text');
@ -114,9 +114,20 @@ while (1) {
$query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX"); $query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX");
(tied %query)->shunlock; (tied %query)->shunlock;
} elsif (not defined $query{fifoName}) { } elsif (not defined $query{fifoName}) {
if (defined $query{format} and $query{format} ne 'text') {
print STDERR "format string $query{format} is not supported yet!\n";
(tied %query)->shlock;
$query{question} = $query{format} = undef;
$query{fifoName} = mktemp("REJECTED_beancount-$query{format}_not_supported_${$}_XXXXXXXXX");
(tied %query)->shunlock;
next;
}
print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0; print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0;
$rbcOut = ""; $rbcOut = "";
$rbcIn = $query{question}; $rbcErr = "";
my $ques = $query{question};
$ques =~ s/\n/ /gm;
$rbcIn = "$ques\n";
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m; pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
(tied %query)->shlock; (tied %query)->shlock;
print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 1; print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 1;
@ -130,14 +141,29 @@ while (1) {
(tied %query)->shunlock; (tied %query)->shunlock;
open(my $fifoFH, ">", $fifoFileName); open(my $fifoFH, ">", $fifoFileName);
print STDERR "and beginning write to it." if $VERBOSE > 1; print STDERR "and beginning write to it." if $VERBOSE > 1;
my($seenSeperator, $prevLine) = (0, "");
foreach my $line (split /\n/, $rbcOut) { 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
# of ----'s. Thus, this only works in text mode right now.
unless ($seenSeperator) {
if ($line =~ /^\s*$/) {
$seenSeperator = 1;
} elsif ($currentFormat eq 'text' and $line =~ /^\s*\-+\s*$/) {
$seenSeperator = 1;
print "$prevLine\n";
}
$prevLine = $line;
next;
}
last if $line =~ /^\s*beancount\s*\>\s*/; last if $line =~ /^\s*beancount\s*\>\s*/;
print STDERR "." unless ($cnt++ % 500) or ($VERBOSE <= 1); print STDERR "." unless ($cnt++ % 500) or ($VERBOSE <= 1);
print STDERR "$line\n" if $VERBOSE > 3;
print $fifoFH "$line\n"; print $fifoFH "$line\n";
$prevLine = $line;
} }
close $fifoFH; close $fifoFH;
$rbcOut = ""; $rbcOut = "";
$rbcIn = "";
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock; (tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0; print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
} }