NPO-Accounting/beancount-tools-in-Perl
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support Git repository and update it from upstream.

Browse source 
I don't remember what the --repositoryURL option was supposed to do,
but instead I now assume that the it's a Git repository if you give
--branchName and make a copy, and pull from upstream and reload when
there are updates.
This commit is contained in:
Bradley M. Kuhn 2020-08-30 20:14:54 -07:00
parent ce4c406fe6
commit 72559aa8d6
No known key found for this signature in database
GPG key ID: F15E8BD6D05E26B3
1 changed files with 96 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

119
bean-query-goofy-daemon.plx
View file

@ -7,27 +7,34 @@ use strict;
use warnings; use warnings;
use autodie qw(:all); use autodie qw(:all);
use sigtrap 'handler' => \&CleanupEvertything, 'normal-signals', 'stack-trace' => 'error-signals';
use Carp;
use Getopt::Long; use Getopt::Long;
use File::Spec::Functions; use File::Spec::Functions;
use File::Temp qw/:mktemp/; use File::Temp qw/:mktemp tempdir/;
use Git::Repository 'Log';
use POSIX qw(mkfifo); use POSIX qw(mkfifo);
use IPC::Shareable; use IPC::Shareable;
use Expect; use Expect;
my $RSYNC_CMD = '/usr/bin/rsync';
# We have to set the PAGER to a passthrough text program to assure that # We have to set the PAGER to a passthrough text program to assure that
# output does not get paused # output does not get paused
$ENV{PAGER} = "/usr/bin/cat"; $ENV{PAGER} = "/usr/bin/cat";
my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query"; my $BEANCOUNT_QUERY_CMD = "/usr/bin/bean-query";
my($VERBOSE, $BEANCOUNT_DIR, $LOAD_FILE, $REPOSITORY_URL, $FIFO_DIR) = (0, undef, undef, undef, undef); my($VERBOSE, $BEANCOUNT_DIR, $LOAD_FILE, $BRANCH_NAME, $FIFO_DIR) = (0, undef, undef, undef, undef);
GetOptions("verbose=i" => \$VERBOSE, "beancountDir=s" => \$BEANCOUNT_DIR, GetOptions("verbose=i" => \$VERBOSE, "beancountDir=s" => \$BEANCOUNT_DIR,
"loadFile=s" => \$LOAD_FILE, "repositoryURL=s" => \$REPOSITORY_URL, 'fifoDir=s' => \$FIFO_DIR); "loadFile=s" => \$LOAD_FILE, "branchName=s" => \$BRANCH_NAME, 'fifoDir=s' => \$FIFO_DIR);
sub UsageAndExit($) { 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 "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"; print STDERR "\n $_[0]\n";
exit 2; exit 2;
} }
@ -41,21 +48,60 @@ chdir $BEANCOUNT_DIR;
UsageAndExit("/path/to/file.beancount must a relative path to a file that exists in $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); unless (defined $LOAD_FILE and -r $LOAD_FILE);
if (defined $REPOSITORY_URL) { my($tempRepository, $tempRepositoryDirectory);
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"); sub CleanupEvertything {
my $repoString; $tempRepository = undef if (defined $tempRepository);
while (my $line = <$gitFH>) { $tempRepositoryDirectory = undef if (defined $tempRepositoryDirectory);
chomp $line; StopRunningBeanQuery();
$repoString = $1 croak @_;
if $line =~ /^\s*url\s*=\s*(\S+)\s*$/; }
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.");
} }
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 $glue = 'BeAn';
my %options = ( my %options = (
@ -81,34 +127,61 @@ sub StartRunningBeanQuery {
$format = $currentFormat unless defined $format; $format = $currentFormat unless defined $format;
$currentFormat = $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); my @cmd = ($BEANCOUNT_QUERY_CMD);
push(@cmd, '-f', $format) if defined $format; push(@cmd, '-f', $format) if defined $format;
push(@cmd, $LOAD_FILE); push(@cmd, $LOAD_FILE);
print STDERR "Starting beancount..." if $VERBOSE > 4;
$runningBeanQuery = Expect->spawn(@cmd); $runningBeanQuery = Expect->spawn(@cmd);
print STDERR "...spawned & loading data..." if $VERBOSE > 4;
$runningBeanQuery->log_stdout(0); $runningBeanQuery->log_stdout(0);
$runningBeanQuery->expect(undef, -re => '^\s*beancount\s*\>\s*') $runningBeanQuery->expect(undef, -re => '^\s*beancount\s*\>\s*')
or die("Unable to find beancount prompt, output was instead: ". or die("Unable to find beancount prompt, output was instead: ".
$runningBeanQuery->before() . $runningBeanQuery->after()); $runningBeanQuery->before() . $runningBeanQuery->after());
print STDERR "now ready." if $VERBOSE > 4;
print STDERR "Beancount started with output of:\n", $runningBeanQuery->before(), print STDERR "Beancount started with output of:\n", $runningBeanQuery->before(),
$runningBeanQuery->match(), $runningBeanQuery->after(), "\n" $runningBeanQuery->match(), $runningBeanQuery->after(), "\n"
if ($VERBOSE > 3); if ($VERBOSE > 3);
} }
sub StopRunningBeanQuery {
return if not defined $runningBeanQuery;
$runningBeanQuery->send("exit\n");
$runningBeanQuery->soft_close();
}
CheckUpstreamAndPull();
StartRunningBeanQuery('text'); StartRunningBeanQuery('text');
print STDERR "Beancount started. Main loop begins." if $VERBOSE > 0; print STDERR "Beancount started. Main loop begins." if $VERBOSE > 0;
while (1) { while (1) {
if (not defined $query{question}) { if (not defined $query{question}) {
print STDERR "No question posed..." if $VERBOSE > 2; print STDERR "No question posed..." if $VERBOSE > 5;
if (CheckUpstreamAndPull()) {
StopRunningBeanQuery();
StartRunningBeanQuery();
}
if (defined $query{fifoName}) { if (defined $query{fifoName}) {
print STDERR "fifo still active; locking to clear it..." if $VERBOSE > 2; print STDERR "fifo still active; locking to clear it..." if $VERBOSE > 5;
(tied %query)->shlock; (tied %query)->shlock;
print STDERR "clearing fifo, $query{fifoName}..." if $VERBOSE > 2; print STDERR "clearing fifo, $query{fifoName}..." if $VERBOSE > 5;
no autodie 'unlink'; unlink($query{fifoName}); no autodie 'unlink'; unlink($query{fifoName});
%query = (); %query = ();
(tied %query)->shunlock; (tied %query)->shunlock;
print STDERR "fifo cleared & lock released." if $VERBOSE > 2; print STDERR "fifo cleared & lock released." if $VERBOSE > 5;
} }
print STDERR "sleep for 2 seconds\n" if $VERBOSE > 2; print STDERR "sleep for 2 seconds\n" if $VERBOSE > 5;
sleep 2; sleep 2;
next; next;
} elsif ($query{question} !~ /^[\,\=\~\-\@\w.\s\"\'\_\(\)\<\>\*\.\!]+$/) { } elsif ($query{question} !~ /^[\,\=\~\-\@\w.\s\"\'\_\(\)\<\>\*\.\!]+$/) {