beancount-tools-in-Perl/bean-query-daemon-lib.pl
Bradley M. Kuhn 02a2fcbbc9
Don't try to cleanup data in client when FIFO doesn't appear.
I think it was in error to go for a lock on the data and clear it —
even if it's data the client had set — when we timeout waiting for
the named pipe to appear.  If the named pipe never appeared, then
something is likely really wrong with the server anyway, and as such,
we might as well expect the server to do the cleanup.
2020-06-16 13:37:42 -07:00

52 lines
1.8 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;
my $cnt = 0;
while (not defined $BEANCOUNT_QUERY{fifoName}) {
sleep 1;
die "Unable to initiate query to beancount server\n" if ($cnt++ >= (5 * 60));
}
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;