839799beac
These were an omnibus set of changes that I made during the FY 2020 fundraising season. Changes include: * support BeanCount for query of amounts given. * better UTF-8 support * use variable for the total groups * use postal address to see if someone is USA based * commented out code for annual renewal notice, we may want that later * Include supporter id and rt ticket in output Note that for each mailing, the groups code is still modified by hand here.
275 lines
10 KiB
Perl
275 lines
10 KiB
Perl
#!/usr/bin/perl
|
|
|
|
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Time::HiRes qw(usleep nanosleep);
|
|
use File::Spec::Functions;
|
|
|
|
use autodie qw(:all);
|
|
use DBI;
|
|
|
|
use Date::Manip::DM5;
|
|
use Supporters;
|
|
use Encode qw(encode decode);
|
|
use Email::MIME::RFC2047::Encoder;
|
|
use utf8;
|
|
use IPC::Shareable;
|
|
|
|
require 'bean-query-daemon-lib.pl';
|
|
|
|
my $TOTAL_GROUPS = 2;
|
|
|
|
BeancountQueryInitialize();
|
|
binmode STDOUT, ":utf8";
|
|
|
|
my $encoder = Email::MIME::RFC2047::Encoder->new();
|
|
|
|
my $TODAY = UnixDate(ParseDate("today"), '%Y-%m-%d');
|
|
my $FORTY_FIVE_DAYS_AGO = UnixDate(ParseDate("45 days ago"), '%Y-%m-%d');
|
|
my $SIXTY_DAYS_AGO = UnixDate(ParseDate("60 days ago"), '%Y-%m-%d');
|
|
my $NINETY_DAYS_AGO = UnixDate(ParseDate("90 days ago"), '%Y-%m-%d');
|
|
my $ONE_AND_HALF_YEARS_AGO = UnixDate(ParseDate("18 months ago"), '%Y-%m-%d');
|
|
my $ONE_YEAR_AGO = UnixDate(ParseDate("12 months ago"), '%Y-%m-%d');
|
|
my $NINE_MONTHS_AGO = UnixDate(ParseDate("9 months ago"), '%Y-%m-%d');
|
|
my $FIFTEEN_MONTHS_AGO = UnixDate(ParseDate("15 months ago"), '%Y-%m-%d');
|
|
my $NINETEEN_MONTHS_AGO = UnixDate(ParseDate("19 months ago"), '%Y-%m-%d');
|
|
my $THREE_TWENTY_DAYS_AGO = UnixDate(ParseDate("320 days ago"), '%Y-%m-%d');
|
|
my $FY_2019_FUNDRAISER_START = UnixDate(ParseDate("2019-11-26 08:00"), '%Y-%m-%d');
|
|
my $NOV_19_2018 = UnixDate(ParseDate("2018-11-19 08:00"), '%Y-%m-%d');
|
|
my $NOV_20_2019 = UnixDate(ParseDate("2018-11-20 08:00"), '%Y-%m-%d');
|
|
my $NOV_24_2020 = UnixDate(ParseDate("2020-11-24 00:00"), '%Y-%m-%d');
|
|
my $NOV_20_2020 = UnixDate(ParseDate("2020-11-20 00:00"), '%Y-%m-%d');
|
|
my $JAN_20_2019 = UnixDate(ParseDate("2019-01-20 08:00"), '%Y-%m-%d');
|
|
my $JAN_15_2020 = UnixDate(ParseDate("2020-01-15 08:00"), '%Y-%m-%d');
|
|
my $JAN_15_2019 = UnixDate(ParseDate("2019-01-15 08:00"), '%Y-%m-%d');
|
|
my $JAN_1_2020 = UnixDate(ParseDate("2020-01-01 08:00"), '%Y-%m-%d');
|
|
my $START_OF_CY_2020_FUNDRAISER = UnixDate(ParseDate("2020-11-24 00:00"), '%Y-%m-%d');
|
|
my $MAR_1_2020 = UnixDate(ParseDate("2020-03-01 08:00"), '%Y-%m-%d');
|
|
my $MAR_1_2019 = UnixDate(ParseDate("2019-03-01 08:00"), '%Y-%m-%d');
|
|
my $OCT_1_2020 = UnixDate(ParseDate("2020-10-01 08:00"), '%Y-%m-%d');
|
|
my $END_LAST_YEAR = '2017-12-31';
|
|
|
|
if (@ARGV < 6) {
|
|
print STDERR "usage: $0 <SUPPORTERS_SQLITE_DB_FILE> <FROM_ADDRESS> <EMAIL_TEMPLATE_SUFFIX> <BAD_ADDRESS_LIST_FILE> <MONTHLY_SEARCH_REGEX> <ANNUAL_SEARCH_REGEX> <VERBOSE>\n";
|
|
exit 1;
|
|
}
|
|
|
|
my($SUPPORTERS_SQLITE_DB_FILE, $FROM_ADDDRESS, $EMAIL_TEMPLATE_SUFFIX, $BAD_ADDRESS_LIST_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $VERBOSE) = @ARGV;
|
|
$VERBOSE = 0 if not defined $VERBOSE;
|
|
|
|
my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
|
|
{ RaiseError => 1, sqlite_unicode => 1 })
|
|
or die $DBI::errstr;
|
|
|
|
my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
|
|
SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
|
|
WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
|
|
AND ANY_META("program") ~ "Conservancy:Supporters:" AND NOT ANY_META("entity") ~ "^\\s*\$"
|
|
SUPPORTESR_DB_READ
|
|
, 'text');
|
|
open(my $fh, "<", $fileName);
|
|
|
|
my $sp = new Supporters($dbh, $fh, { monthly => $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX});
|
|
|
|
my %groupLines;
|
|
foreach my $group (1 .. $TOTAL_GROUPS) {
|
|
$groupLines{$group} = [];
|
|
open(my $emailFH, "<", "group-${group}" . $EMAIL_TEMPLATE_SUFFIX);
|
|
binmode $emailFH, ":utf8";
|
|
|
|
@{$groupLines{$group}} = <$emailFH>;
|
|
close $emailFH;
|
|
}
|
|
foreach my $group (($TOTAL_GROUPS+1) ... 999) {
|
|
my $file = "group-${group}" . $EMAIL_TEMPLATE_SUFFIX;
|
|
die "$file exists but you didn't include it in any groups" if -f $file;
|
|
}
|
|
|
|
|
|
my %skip = ();
|
|
sub update_skips {
|
|
my $skips = shift;
|
|
my $source_filename = shift;
|
|
open(my $skipFH, '<', $source_filename) or
|
|
die "couldn't open skip file $source_filename: $!";
|
|
while (my $email = <$skipFH>) {
|
|
chomp $email;
|
|
$skips->{$email} = $source_filename;
|
|
}
|
|
close $skipFH;
|
|
}
|
|
if (defined $BAD_ADDRESS_LIST_FILE) {
|
|
update_skips(\%skip, $BAD_ADDRESS_LIST_FILE);
|
|
}
|
|
|
|
my %groupCounts;
|
|
for my $ii (0 .. $TOTAL_GROUPS) { $groupCounts{$ii} = 0; }
|
|
|
|
my(@supporterIds) = $sp->findDonor({});
|
|
open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/2020-12_Postcard',
|
|
'donor-ids-in-usa.txt'));
|
|
my %idsKnownToBeInUSA;
|
|
while (my $idInUSA = <$idsInUSAFH>) {
|
|
chomp $idInUSA;
|
|
$idsKnownToBeInUSA{$idInUSA} = 1;
|
|
}
|
|
close $idsInUSAFH;
|
|
|
|
MAIN_SUPPORTER_LOOP:
|
|
foreach my $id (sort { $a <=> $b } @supporterIds) {
|
|
next unless $sp->isSupporter($id);
|
|
my $donorType = lc($sp->getType($id));
|
|
my $expiresOn = $sp->supporterExpirationDate($id);
|
|
my $isLapsed = ( (not defined $expiresOn) or $expiresOn lt $TODAY);
|
|
|
|
my $amount = $sp->donorTotalGaveInPeriod(donorId => $id);
|
|
my $lastGaveDate = $sp->donorLastGave($id);
|
|
my $firstGaveDate = $sp->donorFirstGave($id);
|
|
my $nineMonthsSinceFirstGave = UnixDate(DateCalc(ParseDate($firstGaveDate), "+ 9 months"), '%Y-%m-%d');
|
|
|
|
# Compute "likely USA"
|
|
my $likelyUSA = 0;
|
|
my $postalAddress = $sp->getPreferredPostalAddress($id);
|
|
my(@postalAddresses) = $sp->getPostalAddresses($id);
|
|
$likelyUSA = 1 if defined $idsKnownToBeInUSA{$id};
|
|
if (not $likelyUSA) {
|
|
foreach $postalAddress (@postalAddresses) {
|
|
$likelyUSA = 1
|
|
if ($postalAddress =~ /United\s*States|USA|,\s*\S+\s+\d{5,5}(\s+|$)|,\s*\S+\s+\d{5,5}\-\d{4,4}(\s+|$)/mi
|
|
and (not $postalAddress =~ /Saudi\s*Arabia|France|Sweden|Uruguay|Bulgaria|Indonesia|Switzerland|Spain|Brasil|Brazil|Estonia|Germany|Bosnia|Herzegovina|Italy|Czech|Finland|Korea|Ireland/im))
|
|
}
|
|
}
|
|
my $group = 0;
|
|
if (not $sp->emailOk($id)) {
|
|
print "NOT-SENT: SUPPORTER $id: supporter is unsubscribed from mass emails.\n";
|
|
$groupCounts{0}++;
|
|
next;
|
|
}
|
|
my $specialContact = "";
|
|
|
|
# Set up emails first in case we want to use it in the group tests below
|
|
my %emails;
|
|
my $email = $sp->getPreferredEmailAddress($id);
|
|
if (defined $email) {
|
|
$emails{$email} = {};
|
|
} else {
|
|
%emails = $sp->getEmailAddresses($id);
|
|
}
|
|
my @badEmails;
|
|
foreach $email (keys %emails) {
|
|
if (defined $skip{$email}) {
|
|
delete $emails{$email};
|
|
push(@badEmails, $email);
|
|
}
|
|
}
|
|
if (scalar(keys %emails) <= 0) {
|
|
print "NOT-SENT: SUPPORTER $id: these email address(es) is/were bad: ",
|
|
join(",", @badEmails), "\n";
|
|
$groupCounts{0}++;
|
|
next;
|
|
}
|
|
my(@emails) = keys(%emails);
|
|
|
|
# if (not $sp->emailOk($id)) {
|
|
# my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'});
|
|
# if (defined $req and defined $req->{requestConfiguration} and
|
|
# $req->{requestConfiguration} eq 'only-one-annual-renewal-notice') {
|
|
# $specialContact = 'only-one-annual-renewal-notice: ';
|
|
# } else {
|
|
# print "NOT-SENT: SUPPORTER $id: has requested no email contact\n";
|
|
# $groupCounts{$group}++;
|
|
# next;
|
|
# }
|
|
# }
|
|
# Use above commented out section instead of next line when you want to send an annual renewal notice and not a mass mailing
|
|
|
|
$lastGaveDate = '0001-01-01' if not defined $lastGaveDate;
|
|
$donorType = 'annual' if not defined $donorType or $donorType eq "";
|
|
if ($lastGaveDate le $NINETEEN_MONTHS_AGO) {
|
|
$group = 1;
|
|
} elsif ($lastGaveDate gt $NINETEEN_MONTHS_AGO and $lastGaveDate lt $NOV_24_2020) {
|
|
$group = 2;
|
|
} elsif ($lastGaveDate ge $NOV_24_2020) {
|
|
$group = 0;
|
|
# if ($lastGaveDate ge $NOV_19_2018 and $lastGaveDate le $JAN_20_2019) {
|
|
# $group = 1;
|
|
# } elsif ($lastGaveDate lt $NOV_19_2018) {
|
|
# $group = 2;
|
|
# } elsif ($lastGaveDate gt $JAN_20_2019 and $lastGaveDate lt $FY_2019_FUNDRAISER_START) {
|
|
# $group = 3;
|
|
# } elsif ($lastGaveDate ge $FY_2019_FUNDRAISER_START) {
|
|
# $group = 4;
|
|
# } elsif ( ($donorType eq 'monthly' and $lastGaveDate lt $NINETY_DAYS_AGO) or
|
|
# $donorType eq 'annual' and $lastGaveDate lt $FIFTEEN_MONTHS_AGO) {
|
|
# $group = 3;
|
|
# } elsif ($donorType eq 'annual' and $lastGaveDate ge $THREE_TWENTY_DAYS_AGO) {
|
|
# $group = 3;
|
|
# } elsif ( ($donorType eq 'annual' and $lastGaveDate le $ONE_AND_HALF_YEARS_AGO) or
|
|
# ($donorType eq 'monthly' and $lastGaveDate le $NINE_MONTHS_AGO) ) {
|
|
# $group = 4;
|
|
# } elsif ($donorType eq 'monthly' and $lastGaveDate gt $NINE_MONTHS_AGO
|
|
# and $lastGaveDate le $FORTY_FIVE_DAYS_AGO) {
|
|
# $group = 5;
|
|
} else {
|
|
die "Supporter $id: not in a group, donor type \"$donorType\" who last gave on \"$lastGaveDate\"";
|
|
}
|
|
if ($group <= 0) {
|
|
print "NOT-SENT: SUPPORTER $id: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate\n";
|
|
$groupCounts{0}++;
|
|
next;
|
|
}
|
|
# Staff testing code
|
|
# next unless ($group == 6); # or $id == 34); # $id == 26
|
|
# $group = 3 if $id == 34;
|
|
|
|
my $fullEmailLine = "";
|
|
my $emailTo = join(' ', @emails);
|
|
my $displayName = $sp->getDisplayName($id);
|
|
foreach my $email (@emails) {
|
|
$fullEmailLine .= ", " if ($fullEmailLine ne "");
|
|
my $line = "";
|
|
if (defined $displayName) {
|
|
$line .= $encoder->encode_phrase($displayName) . " ";
|
|
}
|
|
$line .= "<$email>";
|
|
$fullEmailLine .= $line;
|
|
}
|
|
$expiresOn = "" if not defined $expiresOn;
|
|
my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
|
|
$rtTicket = "" if not defined $rtTicket;
|
|
$rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
|
|
print "SENT: SUPPORTER $id: Group $group: $specialContact", join(",", sort {$a cmp $b } @emails), "\n";
|
|
|
|
open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDDRESS, '-oi', '-oem', '--',
|
|
@emails);
|
|
binmode $sendmailFH, ":utf8";
|
|
print $sendmailFH "To: $fullEmailLine\n";
|
|
foreach my $line (@{$groupLines{$group}}) {
|
|
die "no displayname for this item" if not defined $displayName or $displayName =~ /^\s*$/;
|
|
my $thisLine = $line; # Note: This is needed, apparently $line is by reference?
|
|
$thisLine =~ s/FIXME_DISPLAYNAME/$displayName/g;
|
|
$thisLine =~ s/FIXME_SUPPORTER_ID/$id/g;
|
|
$thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
|
|
print $sendmailFH $thisLine;
|
|
}
|
|
close $sendmailFH;
|
|
usleep(70000);
|
|
$groupCounts{$group}++;
|
|
}
|
|
print "\n\n";
|
|
my $totalSent = 0;
|
|
foreach my $group (sort keys %groupCounts) {
|
|
print "TOTAL IN GROUP $group: $groupCounts{$group}\n";
|
|
$totalSent += $groupCounts{$group} if $group > 0;
|
|
}
|
|
print "\n\nTOTAL EMAILS SENT: $totalSent\n";
|
|
BeancountQueryComplete();
|
|
|
|
###############################################################################
|
|
#
|
|
# Local variables:
|
|
# compile-command: "perl -c send-supporter-emails-by-category.plx"
|
|
# End:
|
|
|