20ac3c5ef7
The server would lock up in cases where a client left a question pending and die()'d due to this timeout. So, before die()'ing, clear the question.
60 lines
2.1 KiB
Perl
60 lines
2.1 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;
|
|
|
|
use IPC::Shareable;
|
|
|
|
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, $getAllOutput) = @_;
|
|
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;
|
|
$BEANCOUNT_QUERY{getAllOutput} = $getAllOutput if defined $getAllOutput;
|
|
(tied %BEANCOUNT_QUERY)->shunlock;
|
|
my $cnt = 0;
|
|
while (not defined $BEANCOUNT_QUERY{fifoName}) {
|
|
sleep 1;
|
|
if ($cnt++ >= (5 * 60)) {
|
|
(tied %BEANCOUNT_QUERY)->shlock;
|
|
$BEANCOUNT_QUERY{question} = undef;
|
|
(tied %BEANCOUNT_QUERY)->shunlock;
|
|
die "Unable to initiate query to beancount server\n" ;
|
|
}
|
|
}
|
|
unless (-p $BEANCOUNT_QUERY{fifoName}) {
|
|
(tied %BEANCOUNT_QUERY)->shlock;
|
|
$BEANCOUNT_QUERY{question} = $BEANCOUNT_QUERY{format} = $BEANCOUNT_QUERY{getAllOutput} = 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;
|