10d809c180
I took a shortcut on some previous changes and it led to only text format being supported. These changes bring back support for csv.
278 lines
11 KiB
Perl
Executable file
278 lines
11 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 sigtrap 'handler' => \&CleanupEvertything, 'normal-signals', 'stack-trace' => 'error-signals';
|
|
|
|
use Carp;
|
|
|
|
use Getopt::Long;
|
|
use File::Spec::Functions;
|
|
use File::Temp qw/:mktemp tempdir/;
|
|
use Git::Repository 'Log';
|
|
|
|
use POSIX qw(mkfifo);
|
|
use IPC::Shareable;
|
|
use Expect;
|
|
|
|
my $RSYNC_CMD = '/usr/bin/rsync';
|
|
|
|
# We have to set the PAGER to a passthrough text program to assure that
|
|
# output does not get paused
|
|
$ENV{PAGER} = "/usr/bin/cat";
|
|
|
|
my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query";
|
|
|
|
my($VERBOSE, $BEANCOUNT_DIR, $LOAD_FILE, $BRANCH_NAME, $FIFO_DIR) = (0, undef, undef, undef, undef);
|
|
|
|
GetOptions("verbose=i" => \$VERBOSE, "beancountDir=s" => \$BEANCOUNT_DIR,
|
|
"loadFile=s" => \$LOAD_FILE, "branchName=s" => \$BRANCH_NAME, '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 [ --branchName=BRANCH_NAME --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);
|
|
|
|
my($tempRepository, $tempRepositoryDirectory);
|
|
|
|
sub CleanupEvertything {
|
|
$tempRepository = undef if (defined $tempRepository);
|
|
$tempRepositoryDirectory = undef if (defined $tempRepositoryDirectory);
|
|
StopRunningBeanQuery();
|
|
croak @_;
|
|
}
|
|
if (defined $BRANCH_NAME) {
|
|
my $absGitRepositoryDirectory = File::Spec->rel2abs( $BEANCOUNT_DIR );
|
|
$tempRepositoryDirectory = tempdir('beancountquerygoofydaemongit_' . $$ . '_XXXXXXXXXXX',
|
|
TMPDIR => 1, CLEANUP => 1);
|
|
print STDERR "Copy Git repository to $tempRepositoryDirectory...." if $VERBOSE > 2;
|
|
system($RSYNC_CMD, '-Ha', "$absGitRepositoryDirectory/", "$tempRepositoryDirectory/");
|
|
print STDERR "copy completed.\n" if $VERBOSE > 2;
|
|
$tempRepository = Git::Repository->new( work_tree => $tempRepositoryDirectory );
|
|
|
|
chdir $tempRepositoryDirectory;
|
|
$tempRepository->run(clean => '-fx', { quiet => 1 });
|
|
$tempRepository->run(reset => '--hard', { quiet => 1 });
|
|
$tempRepository->run(clean => '-fx', { quiet => 1 });
|
|
$tempRepository->run(checkout => '$BRANCH_NAME', { quiet => 1 });
|
|
}
|
|
|
|
sub CheckUpstreamAndPull {
|
|
# Returns true iff. a pull was required and the files have changed.
|
|
return 0 unless (defined $tempRepository);
|
|
my $options = { quiet => 1 };
|
|
if ($VERBOSE > 5) {
|
|
print STDERR "...clean & git pull...";
|
|
$options = {};
|
|
}
|
|
print STDERR "...check if upstream Git changed..." if $VERBOSE > 5;
|
|
my $updateOutput = $tempRepository->run(remote => 'update', $options);
|
|
print "$updateOutput" if defined $updateOutput and $updateOutput !~ /^\s*$/ and $VERBOSE > 5;
|
|
my $curRev = $tempRepository->run('rev-parse' => '@');
|
|
my $remoteRev = $tempRepository->run('rev-parse' => '@{u}');
|
|
my $baseRev = $tempRepository->run('merge-base' => '@', '@{u}');
|
|
print STDERR "...$curRev is current, $remoteRev is remote Rev $baseRev is base...\n" if $VERBOSE > 6;
|
|
if ($curRev eq $remoteRev) {
|
|
print STDERR "no change..." if $VERBOSE > 5;
|
|
return 0;
|
|
} elsif ($curRev eq $baseRev) {
|
|
$tempRepository->run(clean => '-fx', $options);
|
|
$tempRepository->run(reset => '--hard', $options);
|
|
$tempRepository->run(clean => '-fx', $options);
|
|
my $pullOutput = $tempRepository->run('pull');
|
|
print STDERR "\nPerformed pull since remote updated:\n $pullOutput\n" if ($VERBOSE > 0);
|
|
return 1;
|
|
} else {
|
|
CleanupEvertything();
|
|
die("our local Git has $curRev, upstream is at $remoteRev, and the base is $baseRev " .
|
|
"so give up entirely on trying to make this work.");
|
|
}
|
|
}
|
|
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";
|
|
|
|
my ($currentFormat, $runningBeanQuery);
|
|
|
|
sub StartRunningBeanQuery {
|
|
my($format) = @_;
|
|
$format = $currentFormat unless defined $format;
|
|
$currentFormat = $format;
|
|
|
|
if (defined $tempRepository) {
|
|
print STDERR "Clearing temp files from repository..." if $VERBOSE > 4;
|
|
$tempRepository->run(clean => '-fx', { quiet => 1 });
|
|
$tempRepository->run(reset => '--hard', { quiet => 1 });
|
|
$tempRepository->run(clean => '-fx', { quiet => 1 });
|
|
} else {
|
|
my(@findCmd) = ("/usr/bin/find", '.', '-name', '*.picklecache');
|
|
if ($VERBOSE > 4) {
|
|
print STDERR "Cleared the following picklecache files (none listed means none existed)...\n";
|
|
push(@findCmd, '-ls');
|
|
}
|
|
push(@findCmd, '-exec', '/usr/bin/rm', '-f', '{}', ';');
|
|
system(@findCmd);
|
|
print STDERR "...done clearing picklecache files.\n" if ($VERBOSE > 4);
|
|
}
|
|
my @cmd = ($BEANCOUNT_QUERY_CMD);
|
|
push(@cmd, '-f', $format) if defined $format;
|
|
push(@cmd, $LOAD_FILE);
|
|
print STDERR "Starting beancount..." if $VERBOSE > 4;
|
|
$runningBeanQuery = Expect->spawn(@cmd);
|
|
print STDERR "...spawned & loading data..." if $VERBOSE > 4;
|
|
$runningBeanQuery->log_stdout(0);
|
|
$runningBeanQuery->expect(undef, -re => '^\s*beancount\s*\>\s*')
|
|
or die("Unable to find beancount prompt, output was instead: ".
|
|
$runningBeanQuery->before() . $runningBeanQuery->after());
|
|
print STDERR "now ready." if $VERBOSE > 4;
|
|
print STDERR "Beancount started with output of:\n", $runningBeanQuery->before(),
|
|
$runningBeanQuery->match(), $runningBeanQuery->after(), "\n"
|
|
if ($VERBOSE > 3);
|
|
}
|
|
sub StopRunningBeanQuery {
|
|
return if not defined $runningBeanQuery;
|
|
$runningBeanQuery->send("exit\n");
|
|
$runningBeanQuery->soft_close();
|
|
}
|
|
CheckUpstreamAndPull();
|
|
StartRunningBeanQuery('text');
|
|
print STDERR "Beancount started. Main loop begins." if $VERBOSE > 0;
|
|
while (1) {
|
|
if (not defined $query{question}) {
|
|
print STDERR "No question posed..." if $VERBOSE > 5;
|
|
if (CheckUpstreamAndPull()) {
|
|
StopRunningBeanQuery();
|
|
StartRunningBeanQuery();
|
|
}
|
|
if (defined $query{fifoName}) {
|
|
print STDERR "fifo still active; locking to clear it..." if $VERBOSE > 5;
|
|
(tied %query)->shlock;
|
|
print STDERR "clearing fifo, $query{fifoName}..." if $VERBOSE > 5;
|
|
no autodie 'unlink'; unlink($query{fifoName});
|
|
%query = ();
|
|
(tied %query)->shunlock;
|
|
print STDERR "fifo cleared & lock released." if $VERBOSE > 5;
|
|
}
|
|
print STDERR "sleep for 2 seconds\n" if $VERBOSE > 5;
|
|
sleep 2;
|
|
next;
|
|
# } elsif ($query{question} !~ /^[\,\=\~\-\@\w.\s\"\'\_\(\)\<\>\*\.\!\^\:\$\|]+$/) {
|
|
} elsif ($query{question} !~ /^[\s\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}) {
|
|
if (defined $query{format}) {
|
|
unless ($query{format} =~ /^(?:text|csv)$/) {
|
|
print STDERR "format string $query{format} is not supported yet!\n";
|
|
(tied %query)->shlock;
|
|
$query{question} = $query{format} = undef;
|
|
$query{fifoName} = mktemp("REJECTED_beancount-$query{format}_not_supported_${$}_XXXXXXXXX");
|
|
(tied %query)->shunlock;
|
|
next;
|
|
}
|
|
if ($currentFormat ne $query{format}) {
|
|
$runningBeanQuery->send("set format $query{format}\n");
|
|
$runningBeanQuery->expect(undef, 'beancount>') # *Don't* use regex here!
|
|
or die("Unable to find beancount prompt, output was instead: ".
|
|
$runningBeanQuery->before() . $runningBeanQuery->after());
|
|
$currentFormat = $query{format};
|
|
print STDERR "Switched formats to the $currentFormat..." if $VERBOSE > 3;
|
|
my $rbcBefore = $runningBeanQuery->before();
|
|
die("Unable to change format to $currentFormat")
|
|
unless $rbcBefore =~ /format\s*:\s*$currentFormat/ixm;
|
|
}
|
|
}
|
|
print STDERR "Runing query: $query{question}\n" if $VERBOSE > 0;
|
|
my $ques = $query{question};
|
|
$ques =~ s/\n/ /gm;
|
|
$runningBeanQuery->send("$ques\n");
|
|
$runningBeanQuery->expect(undef, 'beancount>') # *Don't* use regex here!
|
|
# See `git annotate` on this line for why no regex.
|
|
or die("Unable to find beancount prompt, output was instead: ".
|
|
$runningBeanQuery->before() . $runningBeanQuery->after());
|
|
(tied %query)->shlock;
|
|
print STDERR "Acquired shlock on tied variable.\n" if $VERBOSE > 2;
|
|
$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 > 2;
|
|
$query{fifoName} = $fifoFileName;
|
|
my $getAllOutput = $query{getAllOutput};
|
|
(tied %query)->shunlock;
|
|
print STDERR "unlocked tied query..." if $VERBOSE > 2;
|
|
open(my $fifoFH, ">", $fifoFileName);
|
|
print STDERR "and began write to fifo." if $VERBOSE > 2;
|
|
my($seenSeperator, $prevLine) = ( ((defined $getAllOutput) and $getAllOutput), "");
|
|
my $rbcOut = $runningBeanQuery->before();
|
|
foreach my $line (split /\n/, $rbcOut) {
|
|
# Occasionally, some of the SELECT statement is printed back to
|
|
# $rbcOut. Avoid reproducing this in output by waiting for the line
|
|
# of ----'s. Thus, this only works in text mode right now.
|
|
unless ($seenSeperator) {
|
|
if ($line =~ /^\s*$/) {
|
|
$seenSeperator = 1;
|
|
} elsif (($currentFormat eq 'text' and $line =~ /^\s*[\-\s]+\s*$/)
|
|
or ($currentFormat eq 'csv' and $line =~ /^\s*(\S+,)*\S+\s*$/)){
|
|
$seenSeperator = 1;
|
|
}
|
|
$prevLine = $line;
|
|
next;
|
|
}
|
|
last if $line =~ /^\s*beancount\s*\>\s*/;
|
|
print STDERR "." unless ($cnt++ % 500) or ($VERBOSE <= 1);
|
|
print $fifoFH "$line\n";
|
|
$prevLine = $line;
|
|
}
|
|
close $fifoFH;
|
|
(tied %query)->shlock; $query{question} = undef; (tied %query)->shunlock;
|
|
print STDERR "...done! Data now in $fifoFileName\n" if $VERBOSE > 0;
|
|
}
|
|
}
|
|
finish $runningBeanQuery;
|
|
|
|
###############################################################################
|
|
#
|
|
# Local variables:
|
|
# compile-command: "perl -c bean-query-goofy-daemon.plx"
|
|
# perl-indent-level: 2
|
|
# End:
|
|
|