42800427f6
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.
122 lines
4.6 KiB
Perl
Executable file
122 lines
4.6 KiB
Perl
Executable file
#!/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;
|
|
|
|
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";
|
|
|
|
while (1) {
|
|
if (not defined $query{question}) {
|
|
print STDERR "No question posed, sleeping 2\n" if $VERBOSE > 2;
|
|
if (defined $query{fifoName}) {
|
|
no autodie 'unlink'; unlink($query{fifoName});
|
|
$query{fifoName} = undef;
|
|
}
|
|
sleep 2;
|
|
next;
|
|
} elsif ($query{question} !~ /^[\-\@\w.\s\"\'\_\(\)]+$/) {
|
|
print STDERR "Query string $query{question} looks suspicious, not running beancount query!\n";
|
|
(tied %query)->shlock;
|
|
$query{question} = undef;
|
|
$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, '-f', 'text', $LOAD_FILE, $query{question});
|
|
print STDERR "Running query: $query{question}\n" if $VERBOSE > 0;
|
|
open(my $beancountFH, "-|", @cmd);
|
|
print STDERR "Running ", join(" ", @cmd), "\n" if $VERBOSE > 1;
|
|
(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;
|
|
while (my $line = <$beancountFH>) {
|
|
print STDERR "." if (++$cnt % 100) and ($VERBOSE > 1);
|
|
print $fifoFH $line;
|
|
}
|
|
close $beancountFH;
|
|
close $fifoFH;
|
|
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
|
|
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
|
|
}
|
|
}
|
|
|
|
|
|
###############################################################################
|
|
#
|
|
# Local variables:
|
|
# compile-command: "perl -c bean-query-goofy-daemon.plx"
|
|
# perl-indent-level: 2
|
|
# End:
|
|
|