NPO-Accounting/beancount-tools-in-Perl
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
beancount-tools-in-Perl/bean-query-goofy-daemon.plx

179 lines
6.8 KiB
Text
Raw Normal View History

bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
#!/usr/bin/perl
# License: AGPLv3-or-later
# see files COPYRIGHT, LICENSE, and AGPL-3.0.txt included in canonical repository for details.
# https://k.sfconservancy.org/NPO-Accounting/beancount-tools-in-Perl
use strict;
use warnings;
use autodie qw(:all);
use Getopt::Long;
use File::Spec::Functions;
use File::Temp qw/:mktemp/;
use POSIX qw(mkfifo);
use IPC::Shareable;
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
use IPC::Run qw(start pump finish timeout);
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query";
my($VERBOSE, $BEANCOUNT_DIR, $LOAD_FILE, $REPOSITORY_URL, $FIFO_DIR) = (0, undef, undef, undef, undef);
GetOptions("verbose=i" => \$VERBOSE, "beancountDir=s" => \$BEANCOUNT_DIR,
"loadFile=s" => \$LOAD_FILE, "repositoryURL=s" => \$REPOSITORY_URL, 'fifoDir=s' => \$FIFO_DIR);
sub UsageAndExit($) {
print STDERR "usage: $0 --loadFile=/path/to/file.beancount --beancountDir=/path/to/beancountdir --fifoDir=/path/to/directory/for/fifos [ --repositoryURL=URL_OF_REPOSITORY --verbose=N ]\n";
print STDERR "\n $_[0]\n";
exit 2;
}
UsageAndExit("/path/to/direcotry/for/fifos must be provided and be an existing directory")
unless (defined $FIFO_DIR and -d $FIFO_DIR);
UsageAndExit("/path/to/file.beancount/path/to/beancountdir must be provided and be an existing directory")
unless (defined $BEANCOUNT_DIR and -d $BEANCOUNT_DIR);
chdir $BEANCOUNT_DIR;
UsageAndExit("/path/to/file.beancount must a relative path to a file that exists in $BEANCOUNT_DIR")
unless (defined $LOAD_FILE and -r $LOAD_FILE);
if (defined $REPOSITORY_URL) {
UsageAndExit("if --repositoryURL is provided, $BEANCOUNT_DIR must be a checkout of a Git repository, but there is no $BEANCOUNT_DIR/.git/config.")
unless (-r '.git/config');
open(my $gitFH, "<", ".git/config");
my $repoString;
while (my $line = <$gitFH>) {
chomp $line;
$repoString = $1
if $line =~ /^\s*url\s*=\s*(\S+)\s*$/;
}
close $gitFH;
UsageAndExit("if --repositoryURL is provided, the checkout found in $BEANCOUNT_DIR must be of that repository, but .git/config does not list a URL.") unless defined $REPOSITORY_URL;
UsageAndExit("if --repositoryURL is provided, the checkout found in $BEANCOUNT_DIR must be of that repository, but it instead appears to be a checkout of $repoString.")
unless ($repoString eq $REPOSITORY_URL);
}
my $glue = 'BeAn';
my %options = (
create => 'yes',
exclusive => 0,
mode => 0600,
destroy => 'yes',
);
my %query;
tie %query, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed for $glue\n";
%query = ();
my %beancountData;
tie %beancountData, 'IPC::Shareable', $glue, { %options } or
die "server: tie failed\n";
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
my ($currentFormat, $runningBeanQuery, $rbcIn, $rbcOut, $rbcErr);
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
sub StartRunningBeanQuery {
my($format) = @_;
$format = $currentFormat unless defined $format;
$currentFormat = $format;
my @cmd = ($BEANCOUNT_QUERY_CMD);
Correct typo on wrong variable used; remove errant print.
2020-08-10 14:46:29 +00:00
push(@cmd, '-f', $format) if defined $format;
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
push(@cmd, $LOAD_FILE);
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
$runningBeanQuery = start \@cmd, '<pty<', \$rbcIn, '>pty>', \$rbcOut, '2>', \$rbcErr;
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
}
StartRunningBeanQuery('text');
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
while (1) {
if (not defined $query{question}) {
Only server should control fifo; client should wait for it to clear On the a classic “concurrency is hard” front, I am slightly proud of myself that I didn't hit this race condition but anticipated that it might occur later. Giving entire control to fifoName to the server makes more sense here, and the client should not submit its query any time either fifoName or question is set. As an extra safeguard, the client will die if it gets the lock and the state for submitting a query isn't right. Finally, added some fifoName removal debugging on the server.
2020-06-15 21:42:33 +00:00
print STDERR "No question posed..." if $VERBOSE > 2;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
if (defined $query{fifoName}) {
Only server should control fifo; client should wait for it to clear On the a classic “concurrency is hard” front, I am slightly proud of myself that I didn't hit this race condition but anticipated that it might occur later. Giving entire control to fifoName to the server makes more sense here, and the client should not submit its query any time either fifoName or question is set. As an extra safeguard, the client will die if it gets the lock and the state for submitting a query isn't right. Finally, added some fifoName removal debugging on the server.
2020-06-15 21:42:33 +00:00
print STDERR "fifo still active; locking to clear it..." if $VERBOSE > 2;
(tied %query)->shlock;
print STDERR "clearing fifo, $query{fifoName}..." if $VERBOSE > 2;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
no autodie 'unlink'; unlink($query{fifoName});
Improve recovery scenario on poorly formatted queries. Because the client defaulted to dying, this left the server in a strange state as the query question wasn't cleared and the “fake failure” named pipe was never opened and processed, since it couldn't be. The server did eventually recover when the client fully died; however, the client has enough information to give up its query when it knows failure has occurred, so that now happens.
2020-06-16 03:40:22 +00:00
%query = ();
Only server should control fifo; client should wait for it to clear On the a classic “concurrency is hard” front, I am slightly proud of myself that I didn't hit this race condition but anticipated that it might occur later. Giving entire control to fifoName to the server makes more sense here, and the client should not submit its query any time either fifoName or question is set. As an extra safeguard, the client will die if it gets the lock and the state for submitting a query isn't right. Finally, added some fifoName removal debugging on the server.
2020-06-15 21:42:33 +00:00
(tied %query)->shunlock;
print STDERR "fifo cleared & lock released." if $VERBOSE > 2;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
}
Only server should control fifo; client should wait for it to clear On the a classic “concurrency is hard” front, I am slightly proud of myself that I didn't hit this race condition but anticipated that it might occur later. Giving entire control to fifoName to the server makes more sense here, and the client should not submit its query any time either fifoName or question is set. As an extra safeguard, the client will die if it gets the lock and the state for submitting a query isn't right. Finally, added some fifoName removal debugging on the server.
2020-06-15 21:42:33 +00:00
print STDERR "sleep for 2 seconds\n" if $VERBOSE > 2;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
sleep 2;
next;
Allow additional characters that often appear in queries.
2020-08-10 04:02:46 +00:00
} elsif ($query{question} !~ /^[\,\=\~\-\@\w.\s\"\'\_\(\)\<\>\*\.\!]+$/) {
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
print STDERR "Query string $query{question} looks suspicious, not running beancount query!\n";
(tied %query)->shlock;
Support `format` option provided by client The format option on bean-query command-line is now an option that the client can pass along. The setting defaults to whatever `bean-query` was going to default to.
2020-06-16 03:37:49 +00:00
$query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX");
(tied %query)->shunlock;
Improve recovery scenario on poorly formatted queries. Because the client defaulted to dying, this left the server in a strange state as the query question wasn't cleared and the “fake failure” named pipe was never opened and processed, since it couldn't be. The server did eventually recover when the client fully died; however, the client has enough information to give up its query when it knows failure has occurred, so that now happens.
2020-06-16 03:40:22 +00:00
sleep 2;
Support `format` option provided by client The format option on bean-query command-line is now an option that the client can pass along. The setting defaults to whatever `bean-query` was going to default to.
2020-06-16 03:37:49 +00:00
} elsif (defined $query{format} and $query{format} !~ /^(?:csv|text)$/) {
print STDERR "format string $query{format} is not text or csv, not running beancount query!\n";
(tied %query)->shlock;
$query{question} = $query{format} = undef;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
$query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX");
(tied %query)->shunlock;
} elsif (not defined $query{fifoName}) {
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
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;
}
Improve recovery scenario on poorly formatted queries. Because the client defaulted to dying, this left the server in a strange state as the query question wasn't cleared and the “fake failure” named pipe was never opened and processed, since it couldn't be. The server did eventually recover when the client fully died; however, the client has enough information to give up its query when it knows failure has occurred, so that now happens.
2020-06-16 03:40:22 +00:00
print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0;
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
$rbcOut = "";
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
$rbcErr = "";
my $ques = $query{question};
$ques =~ s/\n/ /gm;
$rbcIn = "$ques\n";
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
pump $runningBeanQuery until $rbcOut =~ /^\s*beancount\s*\>\s*/m;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
(tied %query)->shlock;
print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 1;
$query{fifoName} = undef;
my $cnt = 0;
my $fifoFileName = mktemp(catfile($FIFO_DIR, "beancount-query-fifo_${$}_XXXXXXXXX"));
mkfifo($fifoFileName, 0700);
die "unable to create fifo in $fifoFileName: $!" unless -p $fifoFileName;
print STDERR "Created $fifoFileName..." if $VERBOSE > 1;
$query{fifoName} = $fifoFileName;
(tied %query)->shunlock;
open(my $fifoFH, ">", $fifoFileName);
print STDERR "and beginning write to it." if $VERBOSE > 1;
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
my($seenSeperator, $prevLine) = (0, "");
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
foreach my $line (split /\n/, $rbcOut) {
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
# 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;
}
$prevLine = $line;
next;
}
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
last if $line =~ /^\s*beancount\s*\>\s*/;
Fix incorrect verbosity. There was a logic error in the test for this verbose message.
2020-06-15 21:52:23 +00:00
print STDERR "." unless ($cnt++ % 500) or ($VERBOSE <= 1);
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
print $fifoFH "$line\n";
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
$prevLine = $line;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
}
close $fifoFH;
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
$rbcOut = "";
Handle repeat of query into STDOUT via pty interface to bean-query 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.
2020-08-10 14:35:32 +00:00
$rbcIn = "";
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
}
}
Convert to use IPC::Run in effort to make faster. 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.
2020-08-10 13:37:08 +00:00
finish $runningBeanQuery;
bean-query daemon: initial version. This is a very basic daemon to run bean-query so that other Perl programs can call it. The speed savings is not really there yet, as to get that, it would need to leave bean-query running, perhaps timing out and reloading files as needed. That's the long term plan. Right now, all that this is useful for is to run another Perl process that wants to submit and receive answers to bean-query.
2020-06-15 19:42:13 +00:00
###############################################################################
#
# Local variables:
# compile-command: "perl -c bean-query-goofy-daemon.plx"
# perl-indent-level: 2
# End:
Reference in a new issue Copy permalink