supporterExpirationDate: tests & implementation
This commit is contained in:
parent
7e424200c7
commit
97f08a7bd8
3 changed files with 116 additions and 6 deletions
|
@ -5,8 +5,8 @@ use ExtUtils::MakeMaker;
|
|||
WriteMakefile(
|
||||
NAME => 'Supporters',
|
||||
VERSION_FROM => 'lib/Supporters.pm', # finds $VERSION, requires EU::MM from perl >= 5.5
|
||||
PREREQ_PM => { DBI => 1.6, 'Sub::Override' => 0.09, 'File::Temp' => 0.2304,
|
||||
'Test::Exception' => 0.35, 'Mail::RFC822::Address' => 0.3 },
|
||||
PREREQ_PM => { DBI => 1.6, 'Sub::Override' => 0.09, 'File::Temp' => 0.2304, 'List::Util' => 0.01,
|
||||
'Test::Exception' => 0.35, 'Mail::RFC822::Address' => 0.3, 'Date::Manip' => 5.65 },
|
||||
ABSTRACT_FROM => 'lib/Supporters.pm', # retrieve abstract from module
|
||||
AUTHOR => 'Bradley M. Kuhn <bkuhn@ebb.org>',
|
||||
LICENSE => 'agpl_3',
|
||||
|
|
|
@ -30,8 +30,11 @@ our @EXPORT = qw(
|
|||
our $VERSION = '0.02';
|
||||
|
||||
use Scalar::Util qw(looks_like_number blessed reftype);
|
||||
use List::Util qw(maxstr);
|
||||
|
||||
use Mail::RFC822::Address;
|
||||
use Carp qw(confess);
|
||||
use Date::Manip::DM5;
|
||||
|
||||
######################################################################
|
||||
|
||||
|
@ -1214,6 +1217,85 @@ sub donorFirstGave($$) {
|
|||
return $self->{ledgerData}{$ledgerEntityId}{__FIRST_GAVE__};
|
||||
}
|
||||
}
|
||||
|
||||
=begin supporterExpirationDate
|
||||
|
||||
Arguments:
|
||||
|
||||
=over
|
||||
|
||||
=item $self
|
||||
|
||||
Current object.
|
||||
|
||||
=item $donorId
|
||||
|
||||
Valid donor id number currently in the database. die() will occur if
|
||||
the id number is not in the database already as a donor id.
|
||||
|
||||
=back
|
||||
|
||||
Returns an ISO 8601 of the expriation date for the supporter identified by
|
||||
donorId. Returns undef if the donor is not a supporter or if the donor has
|
||||
given no donations at all.
|
||||
|
||||
Formula for expiration dates currently is as follows:
|
||||
|
||||
For annuals, consider donations in the last year only. The expiration date
|
||||
is one year from the last donation if the total in the last year >= $120.00
|
||||
|
||||
For monthlies, see if they gave $10 or more in the last 60 days. If they
|
||||
did, their expiration is 60 days from then.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
my $ONE_YEAR_AGO = UnixDate(DateCalc(ParseDate("today"), "- 1 year"), '%Y-%m-%d');
|
||||
my $SIXTY_DAYS_AGO = UnixDate(DateCalc(ParseDate("today"), "- 60 days"), '%Y-%m-%d');
|
||||
|
||||
sub supporterExpirationDate($$) {
|
||||
my($self, $donorId) = @_;
|
||||
|
||||
confess "donorFirstGave: donorId, \"$donorId\" not found in supporter database"
|
||||
unless $self->_verifyId($donorId);
|
||||
|
||||
return undef unless $self->isSupporter($donorId);
|
||||
$self->_readLedgerData() if not defined $self->{ledgerData};
|
||||
|
||||
|
||||
my $entityId = $self->getLedgerEntityId($donorId);
|
||||
|
||||
return undef unless defined $self->{ledgerData}{$entityId};
|
||||
|
||||
my $expirationDate;
|
||||
|
||||
my $type = $self->{ledgerData}{$entityId}{__TYPE__};
|
||||
if ($type eq 'Monthly') {
|
||||
my(@tenOrMore);
|
||||
foreach my $date (keys %{$self->{ledgerData}{$entityId}{donations}}) {
|
||||
next if $date =~ /^__/;
|
||||
push(@tenOrMore, $date) unless ($self->{ledgerData}{$entityId}{donations}{$date} < 10.00);
|
||||
}
|
||||
$expirationDate = UnixDate(DateCalc(maxstr(@tenOrMore), "+ 60 days"), '%Y-%m-%d')
|
||||
if (scalar(@tenOrMore) > 0);
|
||||
|
||||
} elsif ($type eq 'Annual') {
|
||||
my($earliest, $total) = (undef, 0.00);
|
||||
foreach my $date (sort { $a cmp $ b} keys %{$self->{ledgerData}{$entityId}{donations}}) {
|
||||
next if $date =~ /^__/;
|
||||
$total += $self->{ledgerData}{$entityId}{donations}{$date};
|
||||
unless ($total < 120.00) {
|
||||
$earliest = $date;
|
||||
last;
|
||||
}
|
||||
}
|
||||
$expirationDate = UnixDate(DateCalc($earliest, "+ 1 year"), '%Y-%m-%d')
|
||||
if defined $earliest;
|
||||
} else {
|
||||
confess "supporterExpirationDate: does not function on $type";
|
||||
}
|
||||
return $expirationDate;
|
||||
}
|
||||
######################################################################
|
||||
|
||||
=back
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 248;
|
||||
use Test::More tests => 259;
|
||||
use Test::Exception;
|
||||
use Sub::Override;
|
||||
use File::Temp qw/tempfile/;
|
||||
|
@ -42,12 +42,12 @@ my $dbh = get_test_dbh();
|
|||
my($fakeLedgerFH, $fakeLedgerFile) = tempfile("fakeledgerXXXXXXXX", UNLINK => 1);
|
||||
|
||||
print $fakeLedgerFH <<FAKE_LEDGER_TEST_DATA_END;
|
||||
Supporters:Match Pledge 2015-05-04 Whitman-Dick \$-500.00
|
||||
Supporters:Annual 2015-05-04 Whitman-Dick \$-5.00
|
||||
Supporters:Monthly 2015-05-25 Olson-Margaret \$-10.00
|
||||
Supporters:Monthly 2015-01-15 Olson-Margaret \$-10.00
|
||||
Supporters:Monthly 2015-03-17 Olson-Margaret \$-10.00
|
||||
Supporters:Monthly 2015-04-20 Olson-Margaret \$-10.00
|
||||
Supporters:Annual 2015-02-26 Whitman-Dick \$-30.00
|
||||
Supporters:Match Pledge 2015-02-26 Whitman-Dick \$-300.00
|
||||
Supporters:Monthly 2015-02-16 Olson-Margaret \$-10.00
|
||||
Supporters:Monthly 2015-06-30 Olson-Margaret \$-10.00
|
||||
FAKE_LEDGER_TEST_DATA_END
|
||||
|
@ -84,7 +84,8 @@ dies_ok { $sp = new Supporters($dbh, [ "testcmd" ], {annual => 'test' }); }
|
|||
|
||||
my $cmd = [ "/bin/cat", $fakeLedgerFile ];
|
||||
|
||||
$sp = new Supporters($dbh, $cmd);
|
||||
$sp = new Supporters($dbh, $cmd, { monthly => '^Supporters:Monthly',
|
||||
annual => '^Supporters:(?:Annual|Match Pledge)'});
|
||||
|
||||
is($dbh, $sp->dbh(), "new: verify dbh set");
|
||||
is_deeply($sp->ledgerCmd(), $cmd, "new: verify ledgerCmd set");
|
||||
|
@ -773,6 +774,33 @@ lives_ok { $date = $sp->donorFirstGave($olsonId) } "donorFirstGave(): check for
|
|||
|
||||
is($date, '2015-01-15', "donorFirstGave(): ...and returned value is correct. ");
|
||||
|
||||
|
||||
=item supporterExpirationDate
|
||||
|
||||
=cut
|
||||
|
||||
dies_ok { $sp->supporterExpirationDate(undef); } "supporterExpirationDate(): dies with undefined donorId";
|
||||
dies_ok { $sp->supporterExpirationDate("str"); } "supporterExpirationDate(): dies with non-numeric donorId";
|
||||
dies_ok { $sp->supporterExpirationDate(0); } "supporterExpirationDate(): dies with non-existent id";
|
||||
|
||||
lives_ok { $date = $sp->supporterExpirationDate($drapperId) } "supporterExpirationDate(): check for known annual donor success...";
|
||||
|
||||
is($date, '2016-02-26', "supporterExpirationDate(): ...and returned value is correct. ");
|
||||
|
||||
lives_ok { $date = $sp->supporterExpirationDate($olsonId) } "supporterExpirationDate(): check for known monthly donor success...";
|
||||
|
||||
is($date, '2015-08-29', "supporterExpirationDate(): ...and returned value is correct. ");
|
||||
|
||||
lives_ok { $date = $sp->supporterExpirationDate($sterlingId) } "supporterExpirationDate(): check for never donation success...";
|
||||
|
||||
is($date, undef, "supporterExpirationDate(): ...and returned undef.");
|
||||
|
||||
$dbh->do("UPDATE donor SET is_supporter = 0 WHERE id = " . $sp->dbh->quote($campbellId));
|
||||
|
||||
lives_ok { $date = $sp->supporterExpirationDate($campbellId) } "supporterExpirationDate(): check for no supporter success...";
|
||||
|
||||
is($date, undef, "supporterExpirationDate(): ...and returned undef.");
|
||||
|
||||
=back
|
||||
|
||||
=item Internal methods used only by the module itself.
|
||||
|
|
Loading…
Reference in a new issue