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

Add getAllOutput option to query tied variable.

Browse source 
The separator ditching was really a hack that I made to make
unintended queries work, but generally it's relied upon by other
scripts that I use, so I've herein created an option for getting all
the output.
This commit is contained in:
Bradley M. Kuhn 2020-08-30 20:12:20 -07:00
parent 11628b4333
commit e1857dc63f
No known key found for this signature in database
GPG key ID: F15E8BD6D05E26B3
2 changed files with 9 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
bean-query-daemon-lib.pl
View file

@ -15,8 +15,8 @@ sub BeancountQueryInitialize {
die "BEANCOUNT_QUERY: tie failed: is the goffy beancount server running?\n"; die "BEANCOUNT_QUERY: tie failed: is the goffy beancount server running?\n";
} }
sub BeancountQuerySubmit($;$) { sub BeancountQuerySubmit($;$$) {
my($question, $format) = @_; my($question, $format, $getAllOutput) = @_;
while (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) { sleep 1; } while (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) { sleep 1; }
(tied %BEANCOUNT_QUERY)->shlock; (tied %BEANCOUNT_QUERY)->shlock;
if (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) { if (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) {
@ -28,6 +28,7 @@ sub BeancountQuerySubmit($;$) {
} }
$BEANCOUNT_QUERY{question} = $question; $BEANCOUNT_QUERY{question} = $question;
$BEANCOUNT_QUERY{format} = $format if defined $format; $BEANCOUNT_QUERY{format} = $format if defined $format;
$BEANCOUNT_QUERY{getAllOutput} = $getAllOutput if defined $getAllOutput;
(tied %BEANCOUNT_QUERY)->shunlock; (tied %BEANCOUNT_QUERY)->shunlock;
my $cnt = 0; my $cnt = 0;
while (not defined $BEANCOUNT_QUERY{fifoName}) { while (not defined $BEANCOUNT_QUERY{fifoName}) {
@ -36,7 +37,7 @@ sub BeancountQuerySubmit($;$) {
} }
unless (-p $BEANCOUNT_QUERY{fifoName}) { unless (-p $BEANCOUNT_QUERY{fifoName}) {
(tied %BEANCOUNT_QUERY)->shlock; (tied %BEANCOUNT_QUERY)->shlock;
$BEANCOUNT_QUERY{question} = $BEANCOUNT_QUERY{format} = undef; $BEANCOUNT_QUERY{question} = $BEANCOUNT_QUERY{format} = $BEANCOUNT_QUERY{getAllOutput} = undef;
(tied %BEANCOUNT_QUERY)->shunlock; (tied %BEANCOUNT_QUERY)->shunlock;
die "Ceci n'est pas une pipe: BEANCOUNT_QUERY{fifoName}, $BEANCOUNT_QUERY{fifoName}:$!" die "Ceci n'est pas une pipe: BEANCOUNT_QUERY{fifoName}, $BEANCOUNT_QUERY{fifoName}:$!"
} }

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

@ -141,18 +141,19 @@ while (1) {
or die("Unable to find beancount prompt, output was instead: ". or die("Unable to find beancount prompt, output was instead: ".
$runningBeanQuery->before() . $runningBeanQuery->after()); $runningBeanQuery->before() . $runningBeanQuery->after());
(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 > 2;
$query{fifoName} = undef; $query{fifoName} = undef;
my $cnt = 0; my $cnt = 0;
my $fifoFileName = mktemp(catfile($FIFO_DIR, "beancount-query-fifo_${$}_XXXXXXXXX")); my $fifoFileName = mktemp(catfile($FIFO_DIR, "beancount-query-fifo_${$}_XXXXXXXXX"));
mkfifo($fifoFileName, 0700); mkfifo($fifoFileName, 0700);
die "unable to create fifo in $fifoFileName: $!" unless -p $fifoFileName; die "unable to create fifo in $fifoFileName: $!" unless -p $fifoFileName;
print STDERR "Created $fifoFileName..." if $VERBOSE > 1; print STDERR "Created $fifoFileName..." if $VERBOSE > 2;
$query{fifoName} = $fifoFileName; $query{fifoName} = $fifoFileName;
my $getAllOutput = $query{getAllOutput};
(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 > 2;
my($seenSeperator, $prevLine) = (0, ""); my($seenSeperator, $prevLine) = ( ((defined $getAllOutput) and $getAllOutput), "");
my $rbcOut = $runningBeanQuery->before(); my $rbcOut = $runningBeanQuery->before();
foreach my $line (split /\n/, $rbcOut) { foreach my $line (split /\n/, $rbcOut) {
# Occasionally, some of the SELECT statement is printed back to # Occasionally, some of the SELECT statement is printed back to