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

Convert to use IPC::Run in effort to make faster.

Browse source 
By using IPC::Run, the bean-query process need not be restarted every
time.  This shows significant speed improvement.

Note that now, the process will not notice when the Beancount files
change underneath it, or when they query format changes.  Additional
code will be needed to support this.
This commit is contained in:
Bradley M. Kuhn 2020-08-10 06:37:08 -07:00
parent 744ad08644
commit 9f9b110c1d
No known key found for this signature in database
GPG key ID: F15E8BD6D05E26B3
1 changed files with 26 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -13,6 +13,8 @@ use File::Temp qw/:mktemp/;
use POSIX qw(mkfifo);
use IPC::Shareable;
use IPC::Run qw(start pump finish timeout);
my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query";
@ -69,6 +71,21 @@ my %beancountData;
tie %beancountData, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed\n";
my ($currentFormat, $runningBeanQuery, $rbcIn, $rbcOut);
sub StartRunningBeanQuery {
my($format) = @_;
$format = $currentFormat unless defined $format;
$currentFormat = $format;
my @cmd = ($BEANCOUNT_QUERY_CMD);
push(@cmd, '-f', $query{format}) if defined $query{format};
push(@cmd, $LOAD_FILE);
$runningBeanQuery = start \@cmd, '<pty<', \$rbcIn, '>pty>', \$rbcOut;
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
}
StartRunningBeanQuery('text');
while (1) {
if (not defined $query{question}) {
print STDERR "No question posed..." if $VERBOSE > 2;
@ -97,12 +114,10 @@ while (1) {
$query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX");
(tied %query)->shunlock;
} elsif (not defined $query{fifoName}) {
my @cmd = ($BEANCOUNT_QUERY_CMD);
push(@cmd, '-f', $query{format}) if defined $query{format};
push(@cmd, $LOAD_FILE, $query{question});
print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0;
open(my $beancountFH, "-|", @cmd);
print STDERR "Running ", join(" ", @cmd), "\n" if $VERBOSE > 1;
$rbcOut = "";
$rbcIn = $query{question};
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
(tied %query)->shlock;
print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 1;
$query{fifoName} = undef;
@ -115,17 +130,19 @@ while (1) {
(tied %query)->shunlock;
open(my $fifoFH, ">", $fifoFileName);
print STDERR "and beginning write to it." if $VERBOSE > 1;
while (my $line = <$beancountFH>) {
foreach my $line (split /\n/, $rbcOut) {
last if $line =~ /^\s*beancount\s*\>\s*/;
print STDERR "." unless ($cnt++ % 500) or ($VERBOSE <= 1);
print $fifoFH $line;
print STDERR "$line\n" if $VERBOSE > 3;
print $fifoFH "$line\n";
}
close $beancountFH;
close $fifoFH;
$rbcOut = "";
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
}
}
finish $runningBeanQuery;
###############################################################################
#