Conservancy/supporters
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Convert to work with Beancount; constructor takes a filehandle now

Browse source 
The output format for donations changed slightly when we switched to
Beancount at Conservancy from Ledger CLI.  This change now assumes a
specific format of the output for the donations, and takes a
filehandle in the constructor to receive the data.

As such, this effectively makes it slightly less dependent on any
specific donation database, since as long as you can get it into the
format the regex herein expects onto a filehandle, it doesn't matter
what system you use underneath.
This commit is contained in:
Bradley M. Kuhn 2020-11-24 06:02:25 -08:00
parent 81352e70b4
commit 0c477cf4da
1 changed files with 17 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
Supporters/lib/Supporters.pm
View file

@ -52,13 +52,14 @@ Arguments:
and pointing to the right database. This class will take over and control and pointing to the right database. This class will take over and control
the DBI object after C<new()> completes. the DBI object after C<new()> completes.
=item $ledgerCmd =item $ledgerFH
A list reference that contains the main ledger command with any necessary A file handle to read the data for Ledger from. It should be presented
arguments, for looking up donation data. The options should be presented
such that the output is in the form: such that the output is in the form:
ProgramTag Date Entity Amount ProgramTag Date Entity Amount
This FH will be *closed* by the supporter DB object once data is read.
=item $programTypeSearch =item $programTypeSearch
This hash should have two keys: "monthly" and "annual". The values of the This hash should have two keys: "monthly" and "annual". The values of the
@ -72,10 +73,10 @@ Arguments:
sub new ($$;$) { sub new ($$;$) {
my $package = shift; my $package = shift;
my($dbh, $ledgerCmd, $programTypeSearch) = @_; my($dbh, $fh, $programTypeSearch) = @_;
die "new: second argument must be a list ref for the ledger command line" die "new: second argument must be a file handle reference for the ledger data"
unless (defined $ledgerCmd and ref $ledgerCmd and (reftype($ledgerCmd) eq 'ARRAY')); unless (defined $fh and ref $fh);
die "new: keys annual and monthly must be the only keys in this hash" die "new: keys annual and monthly must be the only keys in this hash"
if defined $programTypeSearch and (not (defined $programTypeSearch->{monthly} and defined $programTypeSearch->{annual} if defined $programTypeSearch and (not (defined $programTypeSearch->{monthly} and defined $programTypeSearch->{annual}
@ -84,7 +85,7 @@ sub new ($$;$) {
die "new: first argument must be a database handle" die "new: first argument must be a database handle"
unless (defined $dbh and blessed($dbh) =~ /DBI/); unless (defined $dbh and blessed($dbh) =~ /DBI/);
my $self = bless({ dbh => $dbh, ledgerCmd => $ledgerCmd }, my $self = bless({ dbh => $dbh, ledgerFH => $fh },
$package); $package);
$self->{programTypeSearch} = $programTypeSearch if defined $programTypeSearch; $self->{programTypeSearch} = $programTypeSearch if defined $programTypeSearch;
@ -113,15 +114,15 @@ sub dbh ($) {
} }
###################################################################### ######################################################################
=begin ledgerCmd =begin ledgerFH
Accessor method, returns the ledger command currently used by this Supporters Accessor method, returns the ledger command currently used by this Supporters
object. object.
=cut =cut
sub ledgerCmd ($) { sub ledgerFH ($) {
return $_[0]->{ledgerCmd}; return $_[0]->{ledgerFH};
} }
###################################################################### ######################################################################
sub addSupporter ($$) { sub addSupporter ($$) {
@ -1909,15 +1910,15 @@ use outside of this module.
sub _readLedgerData($) { sub _readLedgerData($) {
my($self) = @_; my($self) = @_;
my @cmd = @{$self->{ledgerCmd}}; my $fh = $self->{ledgerFH};
my %amountTable; my %amountTable;
open(ALL, "-|", @cmd) or confess "unable to run command ledger command: @cmd: $!"; while (my $line = <$fh>) {
while (my $line = <ALL>) {
next if $line =~ /^\s*$/; next if $line =~ /^\s*$/;
warn "Invalid line in @cmd output:\n $line" warn "Invalid line in line in ledgerFH output:\n $line"
unless $line =~ /^\s*([^\d]+)\s+([\d\-]+)\s+(\S*)\s+\$\s*(\-?\s*[\d,\.]+)\s*$/; unless $line =~ /^\s*([^\d]+)\s+([\d\-]+)\s+(\S*)\s+\$?\s*(\-?\s*[\d,\.]+)\s*$/;
my($type, $date, $entityId, $amount) = ($1, $2, $3, $4); my($type, $date, $entityId, $amount) = ($1, $2, $3, $4);
print STDERR "$type, $date, $entityId, $amount\n";
next unless defined $entityId and $entityId !~ /^\s*$/; next unless defined $entityId and $entityId !~ /^\s*$/;
if (defined $self->{programTypeSearch}) { if (defined $self->{programTypeSearch}) {
if ($type =~ /$self->{programTypeSearch}{annual}/) { if ($type =~ /$self->{programTypeSearch}{annual}/) {
@ -1947,7 +1948,7 @@ sub _readLedgerData($) {
$amountTable{$entityId}{__FIRST_GAVE__} = $date $amountTable{$entityId}{__FIRST_GAVE__} = $date
if $date lt $amountTable{$entityId}{__FIRST_GAVE__}; if $date lt $amountTable{$entityId}{__FIRST_GAVE__};
} }
close ALL; die "error($?) running command, @cmd: $!" unless $? == 0; close $fh; die "error($?) reading ledger FH: $!" unless $? == 0;
$self->{ledgerData} = \%amountTable; $self->{ledgerData} = \%amountTable;
} }