136 lines
5.3 KiB
Perl
Executable file
136 lines
5.3 KiB
Perl
Executable file
#!/usr/bin/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 autodie qw(:all);
|
|
|
|
use Getopt::Long;
|
|
use File::Spec::Functions;
|
|
use File::Temp qw/:mktemp/;
|
|
|
|
use POSIX qw(mkfifo);
|
|
use IPC::Shareable;
|
|
|
|
my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query";
|
|
|
|
my($VERBOSE, $BEANCOUNT_DIR, $LOAD_FILE, $REPOSITORY_URL, $FIFO_DIR) = (0, undef, undef, undef, undef);
|
|
|
|
GetOptions("verbose=i" => \$VERBOSE, "beancountDir=s" => \$BEANCOUNT_DIR,
|
|
"loadFile=s" => \$LOAD_FILE, "repositoryURL=s" => \$REPOSITORY_URL, 'fifoDir=s' => \$FIFO_DIR);
|
|
|
|
sub UsageAndExit($) {
|
|
print STDERR "usage: $0 --loadFile=/path/to/file.beancount --beancountDir=/path/to/beancountdir --fifoDir=/path/to/directory/for/fifos [ --repositoryURL=URL_OF_REPOSITORY --verbose=N ]\n";
|
|
print STDERR "\n $_[0]\n";
|
|
exit 2;
|
|
}
|
|
UsageAndExit("/path/to/direcotry/for/fifos must be provided and be an existing directory")
|
|
unless (defined $FIFO_DIR and -d $FIFO_DIR);
|
|
|
|
UsageAndExit("/path/to/file.beancount/path/to/beancountdir must be provided and be an existing directory")
|
|
unless (defined $BEANCOUNT_DIR and -d $BEANCOUNT_DIR);
|
|
chdir $BEANCOUNT_DIR;
|
|
|
|
UsageAndExit("/path/to/file.beancount must a relative path to a file that exists in $BEANCOUNT_DIR")
|
|
unless (defined $LOAD_FILE and -r $LOAD_FILE);
|
|
|
|
if (defined $REPOSITORY_URL) {
|
|
UsageAndExit("if --repositoryURL is provided, $BEANCOUNT_DIR must be a checkout of a Git repository, but there is no $BEANCOUNT_DIR/.git/config.")
|
|
unless (-r '.git/config');
|
|
|
|
open(my $gitFH, "<", ".git/config");
|
|
my $repoString;
|
|
while (my $line = <$gitFH>) {
|
|
chomp $line;
|
|
$repoString = $1
|
|
if $line =~ /^\s*url\s*=\s*(\S+)\s*$/;
|
|
}
|
|
close $gitFH;
|
|
UsageAndExit("if --repositoryURL is provided, the checkout found in $BEANCOUNT_DIR must be of that repository, but .git/config does not list a URL.") unless defined $REPOSITORY_URL;
|
|
UsageAndExit("if --repositoryURL is provided, the checkout found in $BEANCOUNT_DIR must be of that repository, but it instead appears to be a checkout of $repoString.")
|
|
unless ($repoString eq $REPOSITORY_URL);
|
|
}
|
|
my $glue = 'BeAn';
|
|
my %options = (
|
|
create => 'yes',
|
|
exclusive => 0,
|
|
mode => 0600,
|
|
destroy => 'yes',
|
|
);
|
|
my %query;
|
|
tie %query, 'IPC::Shareable', $glue, { %options } or
|
|
die "server: tie failed for $glue\n";
|
|
|
|
%query = ();
|
|
|
|
my %beancountData;
|
|
tie %beancountData, 'IPC::Shareable', $glue, { %options } or
|
|
die "server: tie failed\n";
|
|
|
|
while (1) {
|
|
if (not defined $query{question}) {
|
|
print STDERR "No question posed..." if $VERBOSE > 2;
|
|
if (defined $query{fifoName}) {
|
|
print STDERR "fifo still active; locking to clear it..." if $VERBOSE > 2;
|
|
(tied %query)->shlock;
|
|
print STDERR "clearing fifo, $query{fifoName}..." if $VERBOSE > 2;
|
|
no autodie 'unlink'; unlink($query{fifoName});
|
|
%query = ();
|
|
(tied %query)->shunlock;
|
|
print STDERR "fifo cleared & lock released." if $VERBOSE > 2;
|
|
}
|
|
print STDERR "sleep for 2 seconds\n" if $VERBOSE > 2;
|
|
sleep 2;
|
|
next;
|
|
} elsif ($query{question} !~ /^[\,\=\~\-\@\w.\s\"\'\_\(\)]+$/) {
|
|
print STDERR "Query string $query{question} looks suspicious, not running beancount query!\n";
|
|
(tied %query)->shlock;
|
|
$query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX");
|
|
(tied %query)->shunlock;
|
|
sleep 2;
|
|
} elsif (defined $query{format} and $query{format} !~ /^(?:csv|text)$/) {
|
|
print STDERR "format string $query{format} is not text or csv, not running beancount query!\n";
|
|
(tied %query)->shlock;
|
|
$query{question} = $query{format} = undef;
|
|
$query{fifoName} = mktemp("REJECTED_beancount-query-fifo-this-file-does-not-exist_${$}_XXXXXXXXX");
|
|
(tied %query)->shunlock;
|
|
} elsif (not defined $query{fifoName}) {
|
|
my @cmd = ($BEANCOUNT_QUERY_CMD);
|
|
push(@cmd, '-f', $query{format}) if defined $query{format};
|
|
push(@cmd, $LOAD_FILE, $query{question});
|
|
print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0;
|
|
open(my $beancountFH, "-|", @cmd);
|
|
print STDERR "Running ", join(" ", @cmd), "\n" if $VERBOSE > 1;
|
|
(tied %query)->shlock;
|
|
print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 1;
|
|
$query{fifoName} = undef;
|
|
my $cnt = 0;
|
|
my $fifoFileName = mktemp(catfile($FIFO_DIR, "beancount-query-fifo_${$}_XXXXXXXXX"));
|
|
mkfifo($fifoFileName, 0700);
|
|
die "unable to create fifo in $fifoFileName: $!" unless -p $fifoFileName;
|
|
print STDERR "Created $fifoFileName..." if $VERBOSE > 1;
|
|
$query{fifoName} = $fifoFileName;
|
|
(tied %query)->shunlock;
|
|
open(my $fifoFH, ">", $fifoFileName);
|
|
print STDERR "and beginning write to it." if $VERBOSE > 1;
|
|
while (my $line = <$beancountFH>) {
|
|
print STDERR "." unless ($cnt++ % 500) or ($VERBOSE <= 1);
|
|
print $fifoFH $line;
|
|
}
|
|
close $beancountFH;
|
|
close $fifoFH;
|
|
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
|
|
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
|
|
}
|
|
}
|
|
|
|
|
|
###############################################################################
|
|
#
|
|
# Local variables:
|
|
# compile-command: "perl -c bean-query-goofy-daemon.plx"
|
|
# perl-indent-level: 2
|
|
# End:
|
|
|