beancount-tools-in-Perl/bean-query-daemon-lib.pl
Bradley M. Kuhn a21a35d656
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-15 20:40:22 -07:00

48 lines
1.7 KiB
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;
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";
}
sub BeancountQuerySubmit($;$) {
my($question, $format) = @_;
while (defined $BEANCOUNT_QUERY{fifoName} or defined $BEANCOUNT_QUERY{question}) { sleep 1; }
(tied %BEANCOUNT_QUERY)->shlock;
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}\"!");
}
$BEANCOUNT_QUERY{question} = $question;
$BEANCOUNT_QUERY{format} = $format if defined $format;
(tied %BEANCOUNT_QUERY)->shunlock;
while (not defined $BEANCOUNT_QUERY{fifoName}) { sleep 1; }
unless (-p $BEANCOUNT_QUERY{fifoName}) {
(tied %BEANCOUNT_QUERY)->shlock;
$BEANCOUNT_QUERY{question} = $BEANCOUNT_QUERY{format} = undef;
(tied %BEANCOUNT_QUERY)->shunlock;
die "Ceci n'est pas une pipe: BEANCOUNT_QUERY{fifoName}, $BEANCOUNT_QUERY{fifoName}:$!"
}
(tied %BEANCOUNT_QUERY)->shlock;
return $BEANCOUNT_QUERY{fifoName};
}
sub BeancountQueryComplete {
$BEANCOUNT_QUERY{question} = undef;
(tied %BEANCOUNT_QUERY)->shunlock;
}
1;