supporterExpirationDate: tests & implementation

Supporters/Makefile.PL

@@ -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',

Supporters/lib/Supporters.pm

@@ -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

Supporters/t/Supporters.t

@@ -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.