#!/usr/bin/perl use strict; use warnings; use Time::HiRes qw(usleep nanosleep); use File::Spec::Functions; use autodie qw(:all); use DBI; use Data::Dumper; 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 = 1; binmode STDOUT, ":utf8"; ###################################################################### sub GetMostInformalName ($$) { my($sp, $id) = @_; my($pa) = $sp->getBestPostalAddress($id); return $pa->{first_name} if (defined $pa and defined $pa->{first_name} and $pa->{first_name} !~ /^\s*$/); my $displayName = $sp->getDisplayName($id); return $displayName; } ###################################################################### my %SEEN_SERVERS; sub EmailControlledByGoogle ($) { my($email) = @_; my $isGoogle = 0; die "$email that is unparasable" unless ($email =~ /^\s*[^@]+@(\S+)\s*$/); my $domain = $1; if (not defined $SEEN_SERVERS{$domain}) { my $isFound = 0; open(my $fh , "-|", '/usr/bin/host', '-t', 'mx', $domain); while (my $line = <$fh>) { if ($line =~ /(gmail|google|googlemail)/i) { $isFound = 1; } } $SEEN_SERVERS{$domain} = $isFound; } return ($SEEN_SERVERS{$domain}); } ###################################################################### 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 $THREE_MONTHS_AGO = UnixDate(ParseDate("3 months ago"), '%Y-%m-%d'); my $FY_2019_FUNDRAISER_START = UnixDate(ParseDate("2019-11-26 08:00"), '%Y-%m-%d'); my $VIZIO_ANNOUNCE_DATE = UnixDate(ParseDate("2021-10-19 00:01"), '%Y-%m-%d'); my $MARCH_1_2020 = UnixDate(ParseDate("2020-03-01 08:00"), '%Y-%m-%d'); my $MARCH_1_2023 = UnixDate(ParseDate("2023-03-01 08:00"), '%Y-%m-%d'); my $JAN_15_2022 = UnixDate(ParseDate("2022-01-15 23:59"), '%Y-%m-%d'); my $JUL_11_2023 = UnixDate(ParseDate("2023-07-11 23:59"), '%Y-%m-%d'); my $JAN_15_2023 = UnixDate(ParseDate("2023-01-15 23:59"), '%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 $JAN_31_2019 = UnixDate(ParseDate("2019-01-31 08:00"), '%Y-%m-%d'); my $NOV_24_2020 = UnixDate(ParseDate("2020-11-24 00:00"), '%Y-%m-%d'); my $DEC_8_2020 = UnixDate(ParseDate("2020-12-08 00:00"), '%Y-%m-%d'); my $DEC_22_2020 = UnixDate(ParseDate("2020-12-22 00:00"), '%Y-%m-%d'); my $NOV_20_2020 = UnixDate(ParseDate("2020-11-20 00:00"), '%Y-%m-%d'); my $NOV_20_2022 = UnixDate(ParseDate("2022-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_31_2021 = UnixDate(ParseDate("2021-01-31 20:00"), '%Y-%m-%d'); my $JAN_31_2022 = UnixDate(ParseDate("2022-01-31 20:00"), '%Y-%m-%d'); my $JAN_15_2019 = UnixDate(ParseDate("2019-01-15 08:00"), '%Y-%m-%d'); my $JAN_16_2023 = UnixDate(ParseDate("2023-01-16 08:00"), '%Y-%m-%d'); my $JAN_1_2024 = UnixDate(ParseDate("2024-01-01 08:00"), '%Y-%m-%d'); my $JAN_1_2020 = UnixDate(ParseDate("2020-01-01 08:00"), '%Y-%m-%d'); my $JAN_1_2021 = UnixDate(ParseDate("2021-01-01 08:00"), '%Y-%m-%d'); my $JAN_1_2022 = UnixDate(ParseDate("2022-01-01 08:00"), '%Y-%m-%d'); my $JAN_1_2023 = UnixDate(ParseDate("2023-01-01 00:00"), '%Y-%m-%d'); my $JUN_1_2017 = UnixDate(ParseDate("2017-06-01 08:00"), '%Y-%m-%d'); my $JAN_31_2017 = UnixDate(ParseDate("2017-01-31 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 $MAR_1_2016 = UnixDate(ParseDate("2016-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 = '2020-12-31'; my $OCT_19_2021 = UnixDate(ParseDate("2021-10-19 08:00"), '%Y-%m-%d'); my $NOV_2_2021 = UnixDate(ParseDate("2021-11-02 08:00"), '%Y-%m-%d'); my $NOV_21_2021 = UnixDate(ParseDate("2021-11-21 08:00"), '%Y-%m-%d'); my $NOV_22_2022 = UnixDate(ParseDate("2022-11-22 08:00"), '%Y-%m-%d'); my $OCT_1_2023 = UnixDate(ParseDate("2023-10-01 08:00"), '%Y-%m-%d'); if (@ARGV < 6) { print STDERR "usage: $0 \n"; exit 1; } my($SUPPORTERS_SQLITE_DB_FILE, $FROM_ADDDRESS, $EMAIL_TEMPLATE_SUFFIX, $BAD_ADDRESS_LIST_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $GLUE, $VERBOSE) = @ARGV; $VERBOSE = 0 if not defined $VERBOSE; my %groupLines; foreach my $group (1 .. $TOTAL_GROUPS) { $groupLines{$group} = []; my %ff = ($group => "group-${group}$EMAIL_TEMPLATE_SUFFIX", "${group}-no-html", "no-html-group-${group}$EMAIL_TEMPLATE_SUFFIX"); foreach my $subgroup (sort keys %ff) { open(my $emailFH, "<", $ff{$subgroup}); binmode $emailFH, ":utf8"; @{$groupLines{$subgroup}} = <$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); while (my $email = <$skipFH>) { next if $email =~ /^\s*#/; chomp $email; $skips->{$email} = $source_filename; } close $skipFH; } if (defined $BAD_ADDRESS_LIST_FILE) { update_skips(\%skip, $BAD_ADDRESS_LIST_FILE); } $GLUE = "BeAn" unless defined $GLUE and $GLUE !~ /^\s*$/; BeancountQueryInitialize($GLUE); my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "", { RaiseError => 1, sqlite_unicode => 1 }) or die $DBI::errstr; my $fileName = BeancountQuerySubmit(< $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX}); my %groupCounts; for my $ii (0 .. $TOTAL_GROUPS) { $groupCounts{$ii} = 0; } my(@supporterIds) = $sp->findDonor({}); open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/', 'donor-ids-we-expect-are-probably-usa.txt')); my %idsKnownToBeInUSA; while (my $idInUSA = <$idsInUSAFH>) { chomp $idInUSA; $idsKnownToBeInUSA{$idInUSA} = 1; } close $idsInUSAFH; my $totalSupportersSent = 0; 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(%postalAddresses) = $sp->getPostalAddresses($id); $likelyUSA = 1 if defined $idsKnownToBeInUSA{$id}; if (not $likelyUSA) { foreach my $pid (sort {$a <=> $b} keys %postalAddresses) { my $postalAddress = $postalAddresses{$pid}; if (defined $postalAddress and (not defined $postalAddress->{country} or $postalAddress->{country} =~ /^\s*$/ or $postalAddress->{country} =~ /^\s*(United\s*States|U[\s\.]*S[\s\.]*A[\s\.]*|U\s*S)\s*$/mi)) { $likelyUSA = 1; } } } my $group = 0; my $specialContact = ""; my $annualRenewalText = " "; # if (not $sp->emailOk($id)) { # print "NOT-SENT: SUPPORTER $id: supporter is unsubscribed from mass emails.\n"; # $groupCounts{0}++; # next; # } # Set up emails first in case we want to use it in the group tests below my %emails; my $emailP = $sp->getPreferredEmailAddress($id); if (defined $emailP) { $emails{$emailP} = {}; } else { %emails = $sp->getEmailAddresses($id); } my @badEmails; my $atLeastOneSkipHere = 0; foreach my $email (keys %emails) { if (defined $skip{$email}) { $atLeastOneSkipHere = 1; 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"; $group = 0; $groupCounts{$group}++; next; } my(@emails) = keys(%emails); if (not defined $lastGaveDate) { print "NOT-SENT: SUPPORTER $id: WARNING: very strange, this $donorType donor has never given at all, so not emailing because of that\n"; $group = 0; $groupCounts{$group}++; next; } elsif (not defined $firstGaveDate) { print "NOT-SENT: SUPPORTER $id: WARNING: very strange, this $donorType donor has never given at all, so not emailing because of that\n"; $group = 0; $groupCounts{$group}++; next; } if (not $sp->emailOk($id)) { my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'}); $group = 0; $groupCounts{$group}++; if (defined $req and defined $req->{requestConfiguration} and $req->{requestConfiguration} eq 'only-one-annual-renewal-notice') { print "NOT-SENT: SUPPORTER $id: has requested only one annual-renewal notice, and this mailing is not that.\n"; next; } else { print "NOT-SENT: SUPPORTER $id: has requested no email contact ($req->{requestConfiguration}) so no email will be sent.\n"; next; } print "NOT-SENT: SUPPORTER $id: WARNING: WEIRD ERROR THAT WE COULD NOT FIGURE OUT WHY THIS ONE WANTED NO EMAIL? BUT WE DID NOT SEND\n"; next; } if ($lastGaveDate ge $NOV_22_2022 and $lastGaveDate le $JAN_16_2023) { $group = 1; } elsif ($lastGaveDate ge $NOV_2_2021 and $lastGaveDate le $JAN_15_2022) { $group = 1; } elsif ($lastGaveDate le $NOV_22_2022) { $group = 0; # Gave really really recently, don't send $groupCounts{$group}++; print "NOT-SENT: SUPPORTER $id: supporter gave too long ago, skipping\n"; next; } elsif ($lastGaveDate ge $JAN_16_2023) { $group = 0; # Gave really really recently, don't send $groupCounts{$group}++; print "NOT-SENT: SUPPORTER $id: supporter gave to recently, skipping.\n"; next; } else { BeancountQueryComplete(); die "Supporter $id: not in a group, donor type \"$donorType\" who last gave on \"$lastGaveDate\""; } if ($group <= 0) { print "NOT-SENT: SUPPORTER $id: WARNING: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate, $firstGaveDate, $likelyUSA, @emails\n"; $groupCounts{0}++; next; } $expiresOn = "" if not defined $expiresOn; my $rtTicket = $sp->_getDonorField('rt_ticket', $id); $rtTicket = "" if not defined $rtTicket; $rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne ""; foreach my $emailTo (@emails) { my $displayName = $sp->getDisplayName($id); my $fullEmailLine = ""; if (defined $displayName) { $fullEmailLine .= $encoder->encode_phrase($displayName) . " "; } $fullEmailLine .= "<$emailTo>"; my $thisEmailGroup = $group; $thisEmailGroup = "${group}-no-html" if (EmailControlledByGoogle($emailTo)); open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDDRESS, '-oi', '-oem', '--', $emailTo); binmode $sendmailFH, ":utf8"; print $sendmailFH "To: $fullEmailLine\n"; $displayName = GetMostInformalName($sp, $id); foreach my $line (@{$groupLines{$thisEmailGroup}}) { if (not defined $displayName or $displayName =~ /^\s*$/ ) { BeancountQueryComplete(); die "no displayname for this item"; } 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; $thisLine =~ s/FIXME_ANNUAL_ONLY/$annualRenewalText/g; print $sendmailFH $thisLine; } close $sendmailFH; usleep(41000); $groupCounts{$thisEmailGroup}++; } $totalSupportersSent++; print "SENT: SUPPORTER $id: Group $group: $specialContact", " Count: ", scalar(@emails), ": "; my $moreThanOneEmail = 0; foreach my $email (sort {$a cmp $b } @emails) { print ", " if $moreThanOneEmail; $moreThanOneEmail++; print $email; if (EmailControlledByGoogle($email)) { print " (NO-HTML VERSION)"; } } print "\n"; } BeancountQueryComplete(); print "\n\n"; my $totalSent = 0; foreach my $group (sort keys %groupCounts) { print "TOTAL IN GROUP $group: $groupCounts{$group}\n"; no warnings 'numeric'; $totalSent += $groupCounts{$group} if $group > 0; } print "\n\nTOTAL EMAILS SENT: $totalSent\n"; print "TOTAL SUPPORTERS SENT: $totalSupportersSent\n"; print "\nNOTE: For Sustainers with more than one valid email address on file, they are counted for each email sent. That's why two totals above\n"; ############################################################################### # # Local variables: # compile-command: "perl -c send-supporter-emails-by-category.plx" # End: