new: additional arguments related to ledger.
I'll need a full command line here, as it turns out, and also regular expressions to use for searching for monthly vs. annual donations.
This commit is contained in:
parent
2e14c340ec
commit
724cb77605
2 changed files with 44 additions and 11 deletions
|
@ -29,7 +29,7 @@ our @EXPORT = qw(
|
|||
|
||||
our $VERSION = '0.02';
|
||||
|
||||
use Scalar::Util qw(looks_like_number blessed);
|
||||
use Scalar::Util qw(looks_like_number blessed reftype);
|
||||
use Mail::RFC822::Address;
|
||||
use Carp qw(confess);
|
||||
|
||||
|
@ -51,22 +51,40 @@ Arguments:
|
|||
|
||||
=item $ledgerCmd
|
||||
|
||||
Scalar string that contains the main ledger command (without arguments) to
|
||||
run for looking up Supporter donation data.
|
||||
A list reference that contains the main ledger command with any necessary
|
||||
arguments, for looking up donation data. The options should be presented
|
||||
such that the output is in the form:
|
||||
ProgramTag Date Entity Amount
|
||||
|
||||
=item $programTypeSearch
|
||||
|
||||
This hash should have two keys: "monthly" and "annual". The values of the
|
||||
hash should be a regular expression that matches the ProgramTag lines for
|
||||
categorization of the donations in annual or monthly buckets.
|
||||
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new ($$) {
|
||||
sub new ($$;$) {
|
||||
my $package = shift;
|
||||
my($dbh, $ledgerCmd) = @_;
|
||||
my($dbh, $ledgerCmd, $programTypeSearch) = @_;
|
||||
|
||||
die "new: second argument must be a list ref for the ledger command line"
|
||||
unless (defined $ledgerCmd and ref $ledgerCmd and (reftype($ledgerCmd) eq 'ARRAY'));
|
||||
|
||||
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}
|
||||
and scalar(keys(%$programTypeSearch) == 2)));
|
||||
|
||||
die "new: first argument must be a database handle"
|
||||
unless (defined $dbh and blessed($dbh) =~ /DBI/);
|
||||
|
||||
my $self = bless({ dbh => $dbh, ledgerCmd => $ledgerCmd },
|
||||
$package);
|
||||
|
||||
die "new: first argument must be a database handle"
|
||||
unless (defined $dbh and blessed($dbh) =~ /DBI/);
|
||||
$self->{programTypeSearch} = $programTypeSearch if defined $programTypeSearch;
|
||||
|
||||
# Turn off AutoCommit, and create our own handler that resets the
|
||||
# begin_work/commit reference counter.
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 193;
|
||||
use Test::More tests => 198;
|
||||
use Test::Exception;
|
||||
use Sub::Override;
|
||||
|
||||
|
@ -52,10 +52,25 @@ dies_ok { $sp = new Supporters(undef, "test"); }
|
|||
dies_ok { $sp = new Supporters(bless({}, "Not::A::Real::Module"), "test"); }
|
||||
"new: dies when dbh is blessed into another module.";
|
||||
|
||||
$sp = new Supporters($dbh, "testcmd");
|
||||
dies_ok { $sp = new Supporters($dbh, "testcmd"); }
|
||||
"new: dies when if the command is a string.";
|
||||
|
||||
dies_ok { $sp = new Supporters($dbh, [ "testcmd" ], {}); }
|
||||
"new: dies when programTypeSearch is an empty hash.";
|
||||
|
||||
dies_ok { $sp = new Supporters($dbh, [ "testcmd" ], {monthly => 'test', annual => 'test', dummy => 'test' }); }
|
||||
"new: dies when programTypeSearch has stray value.";
|
||||
|
||||
dies_ok { $sp = new Supporters($dbh, [ "testcmd" ], {monthly => 'test' }); }
|
||||
"new: dies when programTypeSearch key annual is missing .";
|
||||
|
||||
dies_ok { $sp = new Supporters($dbh, [ "testcmd" ], {annual => 'test' }); }
|
||||
"new: dies when programTypeSearch key monthly is missing .";
|
||||
|
||||
$sp = new Supporters($dbh, [ "testcmd" ]);
|
||||
|
||||
is($dbh, $sp->dbh(), "new: verify dbh set");
|
||||
is("testcmd", $sp->ledgerCmd(), "new: verify ledgerCmd set");
|
||||
is_deeply($sp->ledgerCmd(), ["testcmd" ], "new: verify ledgerCmd set");
|
||||
|
||||
|
||||
=pod
|
||||
|
@ -625,7 +640,7 @@ $sp = undef;
|
|||
sub ResetDB($) {
|
||||
$_[0]->disconnect() if defined $_[0];
|
||||
my $tempDBH = get_test_dbh();
|
||||
my $tempSP = new Supporters($tempDBH, "testcmd");
|
||||
my $tempSP = new Supporters($tempDBH, [ "testcmd" ]);
|
||||
return ($tempDBH, $tempSP);
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in a new issue