02a2fcbbc9
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.
52 lines
1.8 KiB
Perl
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;
|