2020-06-15 19:42:13 +00:00
|
|
|
# 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;
|
|
|
|
|
2020-09-25 17:49:34 +00:00
|
|
|
use IPC::Shareable;
|
|
|
|
|
2020-06-15 19:42:13 +00:00
|
|
|
our %BEANCOUNT_QUERY;
|
|
|
|
|
|
|
|
my $IPC_GLUE = 'BeAn';
|
|
|
|
|
|
|
|
sub BeancountQueryInitialize {
|
|
|
|
my %options = (create => 0, exclusive => 0, mode => 0600, destroy => 0);
|
|
|
|
tie %BEANCOUNT_QUERY, 'IPC::Shareable', $IPC_GLUE, { %options } or
|
|
|
|
die "BEANCOUNT_QUERY: tie failed: is the goffy beancount server running?\n";
|
|
|
|
}
|
|
|
|
|
2020-08-31 03:12:20 +00:00
|
|
|
sub BeancountQuerySubmit($;$$) {
|
|
|
|
my($question, $format, $getAllOutput) = @_;
|
2020-06-15 21:42:33 +00:00
|
|
|
while (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) { sleep 1; }
|
2020-06-15 19:42:13 +00:00
|
|
|
(tied %BEANCOUNT_QUERY)->shlock;
|
2020-06-15 21:42:33 +00:00
|
|
|
if (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) {
|
|
|
|
(tied %BEANCOUNT_QUERY)->shunlock;
|
|
|
|
no warnings 'uninitialized';
|
|
|
|
die("caught lock to submit a query, but either fifoName or question was defined, " .
|
|
|
|
"so something is wrong here. " .
|
|
|
|
"fifoName: \"$BEANCOUNT_QUERY{fifoName}\" question: \"$BEANCOUNT_QUERY{question}\"!");
|
|
|
|
}
|
2020-06-15 19:42:13 +00:00
|
|
|
$BEANCOUNT_QUERY{question} = $question;
|
2020-06-16 03:37:49 +00:00
|
|
|
$BEANCOUNT_QUERY{format} = $format if defined $format;
|
2020-08-31 03:12:20 +00:00
|
|
|
$BEANCOUNT_QUERY{getAllOutput} = $getAllOutput if defined $getAllOutput;
|
2020-06-15 19:42:13 +00:00
|
|
|
(tied %BEANCOUNT_QUERY)->shunlock;
|
2020-06-16 04:29:35 +00:00
|
|
|
my $cnt = 0;
|
|
|
|
while (not defined $BEANCOUNT_QUERY{fifoName}) {
|
|
|
|
sleep 1;
|
2020-06-16 20:37:42 +00:00
|
|
|
die "Unable to initiate query to beancount server\n" if ($cnt++ >= (5 * 60));
|
2020-06-16 04:29:35 +00:00
|
|
|
}
|
2020-06-16 03:40:22 +00:00
|
|
|
unless (-p $BEANCOUNT_QUERY{fifoName}) {
|
|
|
|
(tied %BEANCOUNT_QUERY)->shlock;
|
2020-08-31 03:12:20 +00:00
|
|
|
$BEANCOUNT_QUERY{question} = $BEANCOUNT_QUERY{format} = $BEANCOUNT_QUERY{getAllOutput} = undef;
|
2020-06-16 03:40:22 +00:00
|
|
|
(tied %BEANCOUNT_QUERY)->shunlock;
|
|
|
|
die "Ceci n'est pas une pipe: BEANCOUNT_QUERY{fifoName}, $BEANCOUNT_QUERY{fifoName}:$!"
|
|
|
|
}
|
2020-06-15 19:42:13 +00:00
|
|
|
(tied %BEANCOUNT_QUERY)->shlock;
|
|
|
|
return $BEANCOUNT_QUERY{fifoName};
|
|
|
|
}
|
|
|
|
|
|
|
|
sub BeancountQueryComplete {
|
|
|
|
$BEANCOUNT_QUERY{question} = undef;
|
|
|
|
(tied %BEANCOUNT_QUERY)->shunlock;
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|