Conservancy/supporters
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: Conservancy:8f54ebb54c34df537dd6bcdc2888f3d57a0032b7
Branches Tags
Conservancy:master
...
compare: Conservancy:777c77baf96b69a2839118f8a27e2e2e70a28c5e
Branches Tags
Conservancy:master

13 commits
8f54ebb54c ... 777c77baf9

Author SHA1 Message Date
Bradley M. Kuhn
777c77baf9 confess() rather than die() in these locations. 2024-11-18 18:27:06 -08:00
Bradley M. Kuhn
3e4bd08b23 Rework getBestPostalAddress to use new address format. 2024-11-18 18:26:34 -08:00
Bradley M. Kuhn
d8da546803 Include 2023 shirt in ALL. 2024-11-18 18:25:47 -08:00
Bradley M. Kuhn
333b526299 Various additions for views for editing in sqlitebrowser 
I had made these various additions previously and not committed them.
 2024-11-03 15:54:50 -08:00
Bradley M. Kuhn
9f24452cbd Slightly change output from crash. 2024-11-03 15:53:50 -08:00
Bradley M. Kuhn
31961b997c Various changes from last time t-shirts were shipped. 
I had made various changes the last time we shipped t-shirts, but had
never committed them.  These are those changes.
 2024-11-03 15:53:08 -08:00
Bradley M. Kuhn
8dafdf9dc4 Various changes from last year's fundraiser. 
I quickly made changes during last year's fundraiser and did not
commit them contemporaneously.  These are the whole group of changes
made in the FY2023-24 fundraiser.
 2024-11-03 15:52:17 -08:00
Bradley M. Kuhn
b479a6d68d Handle complexities of lapsing soon 2024-11-03 15:50:51 -08:00
Bradley M. Kuhn
265f64b2c0 Correct typo in output string. 2024-11-03 15:50:35 -08:00
Bradley M. Kuhn
07aea9ba74 Remove spurious debugging print to STDERR 2024-11-03 15:49:30 -08:00
Bradley M. Kuhn
10523a2285 Comment out the failure check, unsure why it doesn't work 2023-01-02 15:59:39 -08:00
Bradley M. Kuhn
d80c93f16a These are date fields, not text. 2023-01-02 15:59:12 -08:00
Bradley M. Kuhn
a2dad766e0 Use single quote. 2023-01-02 15:58:35 -08:00
6 changed files with 752 additions and 397 deletions
Show stats Expand all files Collapse all files

51
Supporters/lib/Supporters.pm
View file

@ -812,45 +812,33 @@ Arguments:
=back
Returns a string that is the formatted_postal_address from the postal_address
table entry, and the formatted_postal_address address will be our "best
guess" of the best postal address. Note that the method will "confess"
various concerns it might have about determining the best postal address.
Returns a hash that has the fields of the postal address from the database.
=cut
sub getBestPostalAddress($) {
my($self, $id) = @_;
die "Postal address stuff not fixed yet";
confess "getBestPostalAddress: invalid id, $id" unless $self->_verifyId($id);
die "getBestPostalAddress: invalid id, $id" unless $self->_verifyId($id);
my $pref = $self->getPreferredPostalAddress($id);
my $entries = $self->dbh()->selectall_hashref("SELECT pa.id, pa.formatted_address, at.name, pa.date_encountered " .
my $entries = $self->dbh()->selectall_hashref("SELECT pa.id, pa.first_name, pa.middle_name, pa.last_name, " .
"pa.organization, pa.address_1, pa.address_2, pa.address_3, " .
"pa.city, pa.state_province_or_region, pa.postcode, pa.country, " .
"map.date_valid_from, at.name as type " .
"FROM donor_postal_address_mapping map, address_type at, postal_address pa " .
"WHERE at.id = map.type_id AND pa.id = map.postal_address_id AND " .
"(pa.invalid is NULL OR pa.invalid != 1) " .
"AND map.donor_id = " . $self->dbh->quote($id, 'SQL_INTEGER'),
" map.date_valid_to is NULL AND map.donor_id = " .
$self->dbh->quote($id, 'SQL_INTEGER'),
'id');
my $newest;
my $otherSources = "";
foreach my $pid (keys %{$entries}) {
$newest = $entries->{$pid} unless defined $newest;
if ($newest->{date_encountered} lt $entries->{$pid}{date_encountered}) {
$newest = $entries->{$pid};
if (keys %$entries <= 0) {
carp "getBestPostalAddress: unable to find postal address for id, $id";
return undef;
} elsif (keys %$entries > 1) {
carp "getBestPostalAddress: multiple postal address with date_valid_to as NULL for id, $id";
return undef;
}
$otherSources .= " " . $entries->{$pid}{name} if defined $entries->{$pid}{name} and $entries->{$pid}{name} ne 'paypal';
}
if (defined $pref and $newest->{formatted_address} ne $pref) {
carp("$id: preferred address is different than the newest available address: preferred:\n$pref newest:\n $newest->{formatted_address}\n... returning newest");
} elsif ($newest->{name} eq 'paypal' and $otherSources ne "") {
carp("$id: newest address is from paypal, but we have addresses from other sources, namely, $otherSources that are older")
unless (defined $pref and $newest->{formatted_address} eq $pref);
}
return $newest->{formatted_address};
my($pid) = keys(%$entries);
return $entries->{$pid};
}
######################################################################
@ -1149,12 +1137,12 @@ sub getRequest($$;$) {
my $requestTypeClause = "";
if (defined $requestTypeId) {
$requestType = $self->_lookupRequestTypeById($requestTypeId);
die "getRequest: invalid requestTypeId, \"$requestTypeId\"" unless defined $requestType;
confess "getRequest: invalid requestTypeId, \"$requestTypeId\"" unless defined $requestType;
$requestTypeClause = " AND rt.id = " . $self->dbh->quote($requestTypeId, 'SQL_INTEGER');
} elsif (defined $requestType) {
$requestTypeClause = " AND rt.type = " . $self->dbh->quote($requestType);
} else {
die "getRequest: undefined requestType" unless defined $requestType;
confess "getRequest: undefined requestType" unless defined $requestType;
}
my $req = $self->dbh()->selectall_hashref("SELECT r.id, r.request_type_id, r.request_configuration_id, r.date_requested, r.notes, rt.type " .
"FROM request r, request_type rt WHERE r.request_type_id = rt.id AND " .
@ -1998,7 +1986,6 @@ sub _readLedgerData($) {
warn "Invalid line in line in ledgerFH output:\n $line"
unless $line =~ /^\s*([^\d]+)\s+([\d\-]+)\s+(\S*)\s+\$?\s*(\-?\s*[\d,\.]+)\s*$/;
my($type, $date, $entityId, $amount) = ($1, $2, $3, $4);
print STDERR "$type, $date, $entityId, $amount\n";
next unless defined $entityId and $entityId !~ /^\s*$/;
if (defined $self->{programTypeSearch}) {
if ($type =~ /$self->{programTypeSearch}{annual}/) {
@ -2007,7 +1994,7 @@ sub _readLedgerData($) {
$type = 'Monthly';
}
}
die "Unknown type $type for $entityId from $line" if $type !~ /^(Monthly|Annual)$/ and defined $self->{programTypeSearch};
die "Unknown type \"$type\" for $entityId from $line" if $type !~ /^(Monthly|Annual)$/ and defined $self->{programTypeSearch};
$amount =~ s/,//; $amount = abs($amount);
if (defined $amountTable{$entityId}{donations}{$date}) {
$amountTable{$entityId}{donations}{$date} += $amount;

14
scripts/calculate-renewal-rate.plx
View file

@ -35,7 +35,19 @@ my $yearTot = 0.00;
my %specialContributions;
foreach my $supporterId (@supporterIds) {
my $expiresOn = $sp->supporterExpirationDate($supporterId);
my $type = $sp->getType($supporterId);
# Lapses soon calculation is complicated. Annuals can use the how far in
# advance setting, but we really can't with monthlies. For all we know, a
# monthly donation is about to come in for them, so until they reach their
# 60-day expired mark, which is already included in the expiration date by
# the library, we have to assume they're donation is coming in.
my $isLapsed = ( (not defined $expiresOn) or $expiresOn lt $TODAY);
my $lapsesSoon;
if (defined $expiresOn) {
$lapsesSoon = ($expiresOn le $HOW_FAR_IN_ADVANCE) if ($type =~ /ann/i);
$lapsesSoon = ($expiresOn lt $TODAY) if ($type =~ /month/i);
}
$expiresOn = "NO-FULL-SIGNUP" if not defined $expiresOn;
if (not $isLapsed) {
my $lastYearGave = $sp->donorTotalGaveInPeriod(donorId => $supporterId,
startDate => $ONE_YEAR_AGO, endDate => $TODAY);
@ -53,7 +65,7 @@ my $activeCount = scalar(@supporterIds) - $lapsedCount;
print "\n\nWe have ", scalar(@supporterIds), " supporters and $lapsedCount are lapsed. That's ",
sprintf("%.2f", $per), "%.\nActive supporter count: ", $activeCount, "\n";
print "\n\nTotal (non speical) Given in Year in last year by active supoprters: ", sprintf("%.2f\n", $yearTot);
print "\n\nTotal (non speical) Given in Year in last year by active supporters: ", sprintf("%.2f\n", $yearTot);
print "Average annual contribution by non-lapsed donors: ", sprintf("%.2f\n\n", $yearTot / $activeCount);
print "\n\nSpecial Contributions: \n" if (keys(%specialContributions) > 0);

302
scripts/send-supporter-emails-by-category.plx
View file

@ -1,7 +1,5 @@
#!/usr/bin/perl
#!/usr/bin/perl
use strict;
use warnings;
use Time::HiRes qw(usleep nanosleep);
@ -10,6 +8,8 @@ use File::Spec::Functions;
use autodie qw(:all);
use DBI;
use Data::Dumper;
use Date::Manip::DM5;
use Supporters;
use Encode qw(encode decode);
@ -19,10 +19,39 @@ use IPC::Shareable;
require 'bean-query-daemon-lib.pl';
my $TOTAL_GROUPS = 2;
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');
@ -37,74 +66,77 @@ 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 <SUPPORTERS_SQLITE_DB_FILE> <FROM_ADDRESS> <EMAIL_TEMPLATE_SUFFIX> <BAD_ADDRESS_LIST_FILE> <MONTHLY_SEARCH_REGEX> <ANNUAL_SEARCH_REGEX> <GLUE> <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;
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;
BeancountQueryInitialize("BeAn");
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);
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{$group}} = <$emailFH>;
@{$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) or
die "couldn't open skip file $source_filename: $!";
open(my $skipFH, '<', $source_filename);
while (my $email = <$skipFH>) {
next if $email =~ /^\s*#/;
chomp $email;
$skips->{$email} = $source_filename;
}
@ -113,13 +145,30 @@ sub update_skips {
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(<<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?|Sustainers?|Match Pledge):" 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 %groupCounts;
for my $ii (0 .. $TOTAL_GROUPS) { $groupCounts{$ii} = 0; }
my(@supporterIds) = $sp->findDonor({});
open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/2021-12_Postcard',
'donor-ids-in-usa.txt'));
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;
@ -127,60 +176,52 @@ while (my $idInUSA = <$idsInUSAFH>) {
}
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 $postalAddress = $sp->getPreferredPostalAddress($id);
my(@postalAddresses) = $sp->getPostalAddresses($id);
my(%postalAddresses) = $sp->getPostalAddresses($id);
$likelyUSA = 1 if defined $idsKnownToBeInUSA{$id};
if (not $likelyUSA) {
foreach $postalAddress (@postalAddresses) {
$likelyUSA = 1
if (defined $postalAddress and
$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));
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 = "";
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;
}
}
if (not $sp->emailOk($id)) {
print "NOT-SENT: SUPPORTER $id: supporter is unsubscribed from mass emails.\n";
$groupCounts{0}++;
next;
}
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 $email = $sp->getPreferredEmailAddress($id);
if (defined $email) {
$emails{$email} = {};
my $emailP = $sp->getPreferredEmailAddress($id);
if (defined $emailP) {
$emails{$emailP} = {};
} else {
%emails = $sp->getEmailAddresses($id);
}
my @badEmails;
foreach $email (keys %emails) {
my $atLeastOneSkipHere = 0;
foreach my $email (keys %emails) {
if (defined $skip{$email}) {
$atLeastOneSkipHere = 1;
delete $emails{$email};
push(@badEmails, $email);
}
@ -188,112 +229,111 @@ foreach my $id (sort { $a <=> $b } @supporterIds) {
if (scalar(keys %emails) <= 0) {
print "NOT-SENT: SUPPORTER $id: these email address(es) is/were bad: ",
join(",", @badEmails), "\n";
$groupCounts{0}++;
$group = 0; $groupCounts{$group}++;
next;
}
my(@emails) = keys(%emails);
if ($lastGaveDate ge $NOV_20_2020 and $lastGaveDate le $JAN_31_2021) {
$group = 2;
} elsif ($lastGaveDate ge $NOV_21_2021) {
$group = 1;
} elsif ($lastGaveDate lt $NOV_21_2021 or ($lastGaveDate gt $JAN_31_2021 and $lastGaveDate lt $NOV_20_2020)) {
$groupCounts{-1} = 0 unless defined $groupCounts{-1};
$groupCounts{-1}++;
# 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;
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: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate\n";
print "NOT-SENT: SUPPORTER $id: WARNING: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate, $firstGaveDate, $likelyUSA, @emails\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";
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', '--',
@emails);
open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDDRESS, '-oi', '-oem', '--', $emailTo);
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*$/;
$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(70000);
$groupCounts{$group}++;
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";
BeancountQueryComplete();
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";
###############################################################################
#

176
scripts/send-t-shirts.plx
View file

@ -5,6 +5,7 @@ use warnings;
use autodie qw(:all);
use Data::Dumper;
use Getopt::Long;
use DBI;
use Encode qw(encode decode);
@ -92,116 +93,91 @@ while (my $row = $csv->getline_hr($csvFH)) {
$row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/);
die "no reference1" if (not defined $row->{reference1} );
my(@vals) = split(',', $row->{reference1});
my $id = shift @vals;
$info{$id} = $row;
$info{$id}{shirts} = {}; $info{$id}{extras} = [];
foreach my $item (@vals) {
if ($item =~ /\s*\++\s*(\S.*)$/) {
push(@{$info{$id}{extras}}, $1);
if ($row->{status} =~ /refund\s*pending/i and $row->{'refund status'} =~ /pending/i) {
print STDERR "Refund pending for this item: ", Data::Dumper->Dump([$row]);
next;
}
my($size, $type) = split(/_+/, $item);
die "no reference1" if (not defined $row->{reference1} );
my $val = $row->{reference1};
die( "reference1 \"$row->{reference1}\" doesn't have an ID number on end, for shipment: " . Data::Dumper->Dump([$row]))
unless $val =~ /^\s*(\S+)_(\d+)\s*$/;
my($id, $shirt) = (int $2, $1);
$info{$id}{shirts} = {} unless defined $info{$id}{shirts};
my($size, $type) = split(/_+/, $shirt);
if ($type =~ /2018/) {
$type = 't-shirt-fy2018design-0';
} elsif ($type =~ /vint/i) {
$type = 'vintage';
$type = 't-shirt-vintage-0';
} elsif ($type =~ /2021/i) {
$type = 't-shirt-fy2021design-0';
} elsif ($type =~ /2022/i) {
$type = 't-shirt-cy2022design-0';
} else {
die "$type is not a known t-shirt type";
}
$info{$id}{shirts}{$type} = $size;
}
$info{$id}{shirts}{$type}{size} = $size;
$info{$id}{shirts}{$type}{row} = $row;
}
foreach my $id (sort keys %info) {
my %DESIGN_NICKNAMES = ('t-shirt-fy2018design-0' => 2018, 't-shirt-fy2021design-0' => 2021,
't-shirt-cy2022design-0' => 2022, 't-shirt-vintage-0' => 'vintage');
if ($VERBOSE > 3) {
use Data::Dumper;
print STDERR Data::Dumper->Dump([\%info]);
}
foreach my $id (sort { $a <=> $b } keys %info) {
print "#" x 75;
print "\n";
print "Supporter $id:\n";
foreach my $type (sort { $a cmp $b} keys %{$info{$id}{shirts}}) { print " Shirt: $type: $info{$id}{shirts}{$type}\n " }
foreach my $extra (sort { $a cmp $b} @{$info{$id}{extras}}) { print " EXTRA: $extra\n " }
foreach my $type (sort { $a cmp $b} keys %{$info{$id}{shirts}}) { print " Shirt: $type: $info{$id}{shirts}{$type}{size}\n " }
foreach my $type (keys %{$info{$id}{shirts}}) {
my $row = $info{$id}{shirts}{$type}{row};
my $size = $info{$id}{shirts}{$type}{size};
my $sentData = "";
my $thisHow = "a package sent with stamp.com";
my $service = "The package";
my $delivered = 0;
if (defined $info{$id}{'date delivered'} and $info{$id}{'date delivered'} !~ /^\s*$/) {
if (defined $info{$id}{'class service'} and $info{$id}{'class service'} =~ /int\'l|international/i) {
$service .= " left the USA sorting facility (bound for your country) on $info{$id}{'date delivered'}";
if (defined $row->{'date delivered'} and $row->{'date delivered'} !~ /^\s*$/) {
if (defined $row->{'class service'} and $row->{'class service'} =~ /int\'l|international/i) {
$service .= " left the USA sorting facility (bound for your country) on $row->{'date delivered'}";
} else {
$service .= " was delivered on $info{$id}{'date delivered'}";
$delivered = 1 if $info{$id}{'status'} and $info{$id}{'status'} =~ /eliver/i;
$service .= " was delivered on $row->{'date delivered'}";
$delivered = 1 if $row->{'status'} and $row->{'status'} =~ /eliver/i and not $row->{'status'} =~ /undeliv/i;
}
} else {
$service .= " was shipped";
$thisHow .= " shipped";
if (defined $info{$id}{'ship date'} and $info{$id}{'ship date'} !~ /^\s*$/) {
$service .= " on $info{$id}{'ship date'}";
$thisHow .= " on $info{$id}{'ship date'}";
if (defined $row->{'ship date'} and $row->{'ship date'} !~ /^\s*$/) {
$service .= " on $row->{'ship date'}";
$thisHow .= " on $row->{'ship date'}";
}
}
$service .= " via $info{$id}{carrier}";
$thisHow .= " with $info{$id}{carrier}";
if (defined $info{$id}{'class service'} and $info{$id}{'class service'} !~ /^\s*$/) {
$service .= "'s $info{$id}{'class service'}";
$thisHow .= "'s $info{$id}{'class service'}";
$service .= " via $row->{carrier}";
$thisHow .= " with $row->{carrier}";
if (defined $row->{'class service'} and $row->{'class service'} !~ /^\s*$/) {
$service .= "'s $row->{'class service'}";
$thisHow .= "'s $row->{'class service'}";
}
if (defined $info{$id}{'tracking #'} and $info{$id}{'tracking #'} !~ /^\s*$/) {
$service .= " with tracking number of $info{$id}{'tracking #'}";
$thisHow .= " having a tracking number of $info{$id}{'tracking #'}";
if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/) {
$service .= " with tracking number of $row->{'tracking #'}";
$thisHow .= " having a tracking number of $row->{'tracking #'}";
}
$service .= ".";
my $deliveryStatus = " The postal service has often been quite slow during the pandemic, so please be patient, but if the packge does not arrive within a few weeks, please contact us by replying to this email.";
my $deliveryStatus = " The postal service has often been quite slow during the pandemic, so please be patient, but if the package does not arrive within a few weeks, please contact us by replying to this email.";
if (defined $row->{'status'} and $row->{'status'} =~ /undeliverable/i) {
$deliveryStatus = " Unfortunately, the postal service has notified us that the package was \"$row->{'status'}\". We would appreciate if you'd reply to this email and tell us if you received the package, and possibly send us a new postal address so we can resend it!";
$thisHow .= " ; however, it was marked as \"$row->{'status'}\" by stamps.com";
} elsif (defined $row->{'status'} and $row->{'status'} =~ /rec.*action.*req/i) {
$deliveryStatus = " Unfortunately, the postal service has notified us that the package was not yet delivered because \"$row->{'status'}\". We would appreciate if you'd reply to this email and tell us if you received the package!";
$thisHow .= " ; however, it was marked as \"$row->{'status'}\" by stamps.com";
} elsif ($delivered) {
$deliveryStatus = "The postal service has confirmed delivery occurred, so please contact us *immediately* by replying to this email if the packge has not been received."
if $delivered;
my @requestTypes = $sp->getRequestType();
my $sizesSent;
my %need;
foreach my $type (@requestTypes) {
my $request = $sp->getRequest({ donorId => $id, requestType => $type,
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
$need{$type} = $request->{requestConfiguration} if $type =~ /^\s*t-shirt/;
}
}
my $cur = 't-shirt-fy2018design-0';
if (defined $need{$cur} and defined $info{$id}{shirts}{$cur}) {
die "$id: 2018design: $need{$cur} does not match defined $info{$id}{shirts}{$cur}"
unless (($need{$cur} eq $info{$id}{shirts}{$cur}) or
($need{$cur} eq 'FittedLadies2XL' and $info{$id}{shirts}{$cur} eq 'Ladies2XL'));
my $size = $info{$id}{shirts}{$cur};
$sp->fulfillRequest({ donorId => $id, requestType => $cur, who => $WHO, how => $thisHow});
$sentData .= "A $size t-shirt in the 2018 design. ";
delete $need{$cur};
delete $info{$id}{shirts}{$cur};
}
# vintage type can fulfill other types
foreach my $shirtType (keys %{$info{$id}{shirts}}) {
my $size = $info{$id}{shirts}{$shirtType};
foreach my $key (keys %need) {
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
if ($need{$key} eq $size) {
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $thisHow});
$sentData .= "A $size t-shirt in the vintage design. ";
delete $need{$key};
delete $info{$id}{shirts}{$shirtType};
}
}
}
foreach my $shirtType (keys %{$info{$id}{shirts}}) {
my $size = $info{$id}{shirts}{$shirtType};
$sentData .= "A $size t-shirt in the $shirtType design that we included just becuase we thought you would like it. ";
}
foreach my $extra (sort { $a cmp $b} @{$info{$id}{extras}}) {
if ($extra =~ /PIN/) {
$sentData .= " A pin from our our CopyleftConf 2019! ";
} else {
die "Supporter $id: unkown extra: $extra";
}
}
$info{$id}{shirts}{$type}{thisHow} = $thisHow;
$sentData .= "A $size t-shirt in the $DESIGN_NICKNAMES{$type} design. ";
my $sentSize = $size; my $sentType = "in the $DESIGN_NICKNAMES{$type} design";
my %emails;
my $email = $sp->getPreferredEmailAddress($id);
if (defined $email) {
@ -240,11 +216,51 @@ foreach my $id (sort keys %info) {
$thisLine =~ s/FIXME_DELVIERY_STATUS_INFO/$deliveryStatus/g;
$thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
$thisLine =~ s/FIXME_POSTAL_SERVICE_INFO/$service/g;
$thisLine =~ s/FIXME_SENT_SIZE/$sentSize/g;
$thisLine =~ s/FIXME_SENT_TYPE/$sentType/g;
print $sendmailFH $thisLine;
}
close $sendmailFH;
usleep(70000);
}
}
foreach my $id (sort keys %info) {
my @requestTypes = $sp->getRequestType();
my %need;
foreach my $requestType (@requestTypes) {
my $request = $sp->getRequest({ donorId => $id, requestType => $requestType,
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
$need{$request->{requestType}} = $request->{requestConfiguration} if $request->{requestType} =~ /^\s*t-shirt/;
}
}
foreach my $type (keys %{$info{$id}{shirts}}) {
my $size = $info{$id}{shirts}{$type}{size};
foreach my $key (keys %need) {
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
if ($need{$key} eq $size and $type eq $key) {
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
delete $need{$key};
delete $info{$id}{shirts}{$type};
}
}
}
foreach my $type (keys %{$info{$id}{shirts}}) {
my $size = $info{$id}{shirts}{$type}{size};
foreach my $key (keys %need) {
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
if ($need{$key} eq $size and $key =~ /^t-shirt-(extra-)?[0123456789]/) {
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
delete $need{$key};
delete $info{$id}{shirts}{$type};
}
}
}
foreach my $type (keys %{$info{$id}{shirts}}) {
print "WARNING: For $id, shirt of $type in size $info{$id}{shirts}{$type}{size} did not fulfill a request\n";
}
}
###############################################################################
#

322
scripts/t-shirt-label-print.plx
View file

@ -5,48 +5,110 @@ use strict;
use warnings;
use autodie qw(open close chdir);
use Getopt::Long;
use DBI;
use Encode qw(encode decode);
use Text::CSV; # libtext-csv-perl in Debian
use YAML::XS qw(LoadFile);
use File::Spec::Functions qw(rel2abs catfile);
use LaTeX::Encode;
use Supporters;
use utf8;
use IPC::Shareable;
sub NotBlank { return (defined($_[0]) and ($_[0] !~ /^\s*$/)); }
my %WEIGHTS =
('2018design' => { Men3XL => 8.5, Men2XL => 7.9, MenXL => 7.1, MenL => 6.4,
MenM => 6.1, FittedLadiesXL => 5.7, FittedLadiesL => 5.6,
FittedLadiesM => 5.4, FittedLadiesS => 4.8,
StandardLadiesXL => 6.4, StandardLadiesL => 5.8, StandardLadiesM => 5.4 },
'2021design' => { Men3XL => 8.6, Men2XL => 8.6, MenXL => 8.4, MenL => 7.7,
MenM => 7, MenS => 5.5, FittedLadies2XL => 5.4, FittedLadiesXL => 5.2,
FittedLadiesL => 5.4, FittedLadiesM => 5.4, StandardLadies2XL => 6.2,
StandardLadiesXL => 6.0, StandardLadiesL => 5.4, StandardLadiesM => 5.4,
StandardLadiesS => 5.3 },
'2022design' => { Men3XL => 8.6, Men2XL => 8.6, MenXL => 8.4, MenL => 7.7,
MenM => 7, MenS => 5.5, FittedLadies2XL => 5.4, FittedLadiesXL => 5.2,
FittedLadiesL => 5.4, FittedLadiesM => 5.4, StandardLadies2XL => 6.2,
StandardLadiesXL => 6.0, StandardLadiesL => 5.4, StandardLadiesM => 5.4,
StandardLadiesS => 5.3 },
'2023design' => { Men3XL => 8.6, Men2XL => 8.6, MenXL => 8.4, MenL => 7.7,
MenM => 7, MenS => 5.5, FittedLadies2XL => 5.4, FittedLadiesXL => 5.2,
FittedLadiesL => 5.4, FittedLadiesM => 5.4, StandardLadies2XL => 6.2,
StandardLadiesXL => 6.0, StandardLadiesL => 5.4, StandardLadiesM => 5.4,
StandardLadiesS => 5.3 },
'vintage' => { MenS => 6.2, MenM => 6.4, MenL => 7.2, MenXL => 8.1, Men2XL => 8.7, Men3XL => 9.5,
StandardLadiesS => 6.2, StandardLadiesM => 7.1, StandardLadiesL => 5.8,
StandardLadiesXL => 6.2, StandardLadies2XL => 6.6, FittedLadiesS => 4.6,
FittedLadiesM => 4.9, FittedLadiesL => 5.3, FittedLadiesXL => 5.7 });
my @headerFields = ('Order ID (required)', 'Order Date', 'Order Value', 'Requested Service', 'Ship To - Name', 'Ship To - Company',
'Ship To - Address 1', 'Ship To - Address 2', 'Ship To - Address 3', 'Ship To - State/Province',
'Ship To - City', 'Ship To - Postal Code', 'Ship To - Country', 'Ship To - Phone', 'Ship To - Email',
'Total Weight in Oz', 'Dimensions - Length', 'Dimensions - Width', 'Dimensions - Height',
'Notes - From Customer', 'Notes - Internal', 'Gift Wrap?', 'Gift Message');
require 'bean-query-daemon-lib.pl';
binmode STDOUT, ":utf8";
BeancountQueryInitialize();
if (@ARGV < 8 or @ARGV > 9) {
print STDERR "usage: $0 <SUPPORTERS_SQLITE_DB_FILE> <GIVING_LIMIT> <T-SHIRT-STYLE> <SIZE_COUNTS> <ID_IN_USA_FILE> <MONTHLY_SEARCH_REGEX> <ANNUAL_SEARCH_REGEX> <VERBOSE>\n";
exit 1;
my($CONSERVANCY_REPOSITORY, $SUPPORTERS_SQLITE_DB_FILE, $VERBOSE, $SERIAL_ORDER_START, $ORDER_PREFIX,
$T_SHIRT_VALUE, $GIVING_LIMIT, $T_SHIRT_STYLE, $SIZE_COUNT_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $GLUE) =
($ENV{CONSERVANCY_REPOSITORY}, undef, 0, 0, undef,
7, 60, undef, undef, '^Conservancy:Supporters:Monthly', '^Conservancy:Supporters:(?:Annual|Match\s*Pledge)', undef, undef);
sub UsageAndExit($) {
print STDERR "usage: $0 --tShirtStyle=STYLE --inventoryFile=/PATH/TO/FILE.yaml [ --tShirtUSDValue --orderPrefix=STR --serialOrderStart=N --givingLimit=N --conservancyRepository=DIRECTORY --supportersDB=PATH_TO_SUPPORTERS_SQLITE_DB_FILE --monthlySearchRegex=REGEX --annualSearchRegex=REGEX --glue=ABCD --verbose=N ]\n";
print STDERR "\n ERROR: $_[0]\n";
print STDERR "\n --tShirtStyle is the primary style we have to give out right now.\n";
print STDERR "\n --inventoryFile is the YAML-formatted file of inventory of shirts.\n";
print STDERR "\n --serialOrderStart is the serial number to start for the order number, defaults to 0\n";
print STDERR "\n --orderPrefix is a string to put in front of the serial order number, the default is undef\n";
print STDERR "\n --givingLimit defaults to 60. The limit someone needs to have given to be allowed a t-shirt.\n";
print STDERR "\n --tShirtUSDValue defaults to 7. The USD value of the t shirt that we are sending (for customs forms). Default is \$7.\n";
print STDERR "\n --monthlySearchRegex is for Supporters.pm; default is '^Conservancy:Supporters:Monthly'\n";
print STDERR "\n --annualSearchRegex is for Supporters.pm; default is '^Conservancy:Supporters:(?:Annual|Match Pledge)'\n";
print STDERR "\n --conservancyRepository defaults to environment variable CONSERVANCY_REPOSITORY (currently $ENV{CONSERVANCY_REPOSITORY})";
print STDERR "\n --supportersDB defaults to ", catfile($CONSERVANCY_REPOSITORY, 'Financial', 'Ledger', 'supporters.db');
print STDERR "\n --glue is the 'glue' string to use for the goofy beancount daemon, default is undef\n";
exit 2;
}
GetOptions("verbose=i" => \$VERBOSE, "supporterDB=s" => \$SUPPORTERS_SQLITE_DB_FILE, 'givingLimit=i' => \$GIVING_LIMIT,
'tShirtStyle=s' => \$T_SHIRT_STYLE, 'inventoryFile=s' => \$SIZE_COUNT_FILE, 'glue=s' => \$GLUE,
'monthlySearchRegex=s' => \$MONTHLY_SEARCH_REGEX, 'annaulSearchRegex=s' => \$ANNUAL_SEARCH_REGEX,
'orderPrefix=s' => \$ORDER_PREFIX, 'serialOrderStart=i' => \$SERIAL_ORDER_START, 'tShirtUSDValue=f' => \$T_SHIRT_VALUE,
'conservancyRepository=s' => \$CONSERVANCY_REPOSITORY) or UsageAndExit('invalid options provided');
my($SUPPORTERS_SQLITE_DB_FILE, $GIVING_LIMIT, $T_SHIRT_STYLE, $SIZE_COUNT_FILE, $ID_IN_USA_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $VERBOSE) = @ARGV;
$VERBOSE = 0 if not defined $VERBOSE;
open(my $idsInUSAFH, "<", $ID_IN_USA_FILE);
my %idsKnownToBeInUSA;
while (my $idInUSA = <$idsInUSAFH>) {
chomp $idInUSA;
$idsKnownToBeInUSA{$idInUSA} = 1;
if ($CONSERVANCY_REPOSITORY ne $ENV{CONSERVANCY_REPOSITORY} and not -d $CONSERVANCY_REPOSITORY) {
UsageAndExit("provided --conservancyRepository is not a directory");
} elsif ($CONSERVANCY_REPOSITORY eq $ENV{CONSERVANCY_REPOSITORY} and not -d $CONSERVANCY_REPOSITORY) {
UsageAndExit("CONSERANCY_REPOSITORY from the environment variable, $ENV{CONSERANCY_REPOSITORY}, is not a directory. Use --conservancyRepository or change the environment variable.");
}
$SUPPORTERS_SQLITE_DB_FILE = catfile($CONSERVANCY_REPOSITORY, 'Financial', 'Ledger', 'supporters.db')
unless (defined $SUPPORTERS_SQLITE_DB_FILE);
UsageAndExit("--supportersDB must be a readable file; $SUPPORTERS_SQLITE_DB_FILE is not.")
unless (-r $SUPPORTERS_SQLITE_DB_FILE);
UsageAndExit("--tShirtStyle must be provided as an option.") unless (defined $T_SHIRT_STYLE);
if (not defined $SIZE_COUNT_FILE) {
UsageAndExit("--inventoryFile must be provided as an option.");
} elsif (not -r $SIZE_COUNT_FILE) {
UsageAndExit("--inventoryFile must be a readable text file; $SIZE_COUNT_FILE is not.");
}
my($sizeCounts);
$sizeCounts = LoadFile $SIZE_COUNT_FILE;
my(@usaRows, @intRows);
my($sizeCounts);
$sizeCounts = LoadFile $SIZE_COUNT_FILE if (defined $SIZE_COUNT_FILE and -r $SIZE_COUNT_FILE);
my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
{ RaiseError => 1, sqlite_unicode => 1 })
or die $DBI::errstr;
BeancountQueryInitialize($GLUE);
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"
@ -63,8 +125,17 @@ my %lines;
my @typeList;
my @oldTypeList;
if ($T_SHIRT_STYLE eq 'ONLY-fy2021design') {
if ($T_SHIRT_STYLE eq 'ALL') {
@typeList = qw/t-shirt-cy2023design-0 t-shirt-cy2022design-0 t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
} elsif ($T_SHIRT_STYLE eq 'ONLY-fy2021design') {
@typeList = qw/t-shirt-fy2021design-0/;
} elsif ($T_SHIRT_STYLE eq 'cy2023design') {
@typeList = qw/t-shirt-cy2023design-0 t-shirt-cy2022design-0 t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
} elsif ($T_SHIRT_STYLE eq 'cy2022design') {
@typeList = qw/t-shirt-cy2022design-0 t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
} elsif ($T_SHIRT_STYLE eq 'fy2021design') {
@typeList = qw/t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
@ -77,7 +148,7 @@ if ($T_SHIRT_STYLE eq 'ONLY-fy2021design') {
@oldTypeList = qw/t-shirt-0 t-shirt-extra-0/;
@typeList = qw/t-shirt-1 t-shirt-extra-1/;
} else {
die "Unknown t-shirt style given: $T_SHIRT_STYLE";
UsageAndExit("--tShirtStyle must be a known t-shirt style setting; $T_SHIRT_STYLE is unknown");
}
my %requestData;
@ -96,6 +167,19 @@ foreach my $id (@supporterIds) {
$requestData{$id}{oldestShirtDate} = '9999-12-31' unless defined $requestData{$id}{oldestShirtDate};
$requestData{$id}{forSortingbySize} = "" unless defined $requestData{$id}{forSortingbySize};
$requestData{$id}{forSortingbyType} = 'ZZZZ' unless defined $requestData{$id}{forSortingbyType};
if ($type =~ /2022/) {
$requestData{$id}{forSortingbyType} = "C-2022" if "C-2022" lt $requestData{$id}{forSortingbyType};
} elsif ($type =~ /2021/) {
$requestData{$id}{forSortingbyType} = "D-2021" if "D-2021" lt $requestData{$id}{forSortingbyType};
} elsif ($type =~ /vintage/) {
$requestData{$id}{forSortingbyType} = "B-vintage" if "B-vintage" lt $requestData{$id}{forSortingbyType};
} elsif ($type =~ /2018/) {
$requestData{$id}{forSortingbyType} = "A-2018" if "A-2018" lt $requestData{$id}{forSortingbyType};
} else {
$requestData{$id}{forSortingbyType} = "E-any" if "E-any" lt $requestData{$id}{forSortingbyType};
}
$requestData{$id}{shirts}{$request->{requestType}} = $request;
$requestData{$id}{forSortingbySize} = $request->{requestConfiguration}
if ($requestData{$id}{forSortingbySize} eq "" and defined $request->{requestConfiguration});
@ -104,24 +188,28 @@ foreach my $id (@supporterIds) {
}
}
}
sub sortFunction($$) { return (($requestData{$_[1]}{total} <=> $requestData{$_[0]}{total}) or
($requestData{$_[1]}{lastGaveDate} cmp $requestData{$_[0]}{lastGaveDate}) or
sub sortFunction($$) { return (($requestData{$_[0]}{forSortingbyType} cmp $requestData{$_[1]}{forSortingbyType}) or
($requestData{$_[0]}{oldestShirtDate} cmp $requestData{$_[1]}{oldestShirtDate}) or
($requestData{$_[0]}{forSortingbySize} cmp $requestData{$_[1]}{forSortingbySize}) or
($requestData{$_[1]}{lastGaveDate} cmp $requestData{$_[0]}{lastGaveDate}) or
($requestData{$_[1]}{total} <=> $requestData{$_[0]}{total}) or
($_[0] <=> $_[1]));
}
my %need;
my $orderNum = $SERIAL_ORDER_START;
foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
next if $id == 20 or $id == 70 or $id == 670 or $id == 34;
print "KAREN\n" if $id == 34;
my $email = $sp->getPreferredEmailAddress($id);
my @emails;
if (not defined $email) {
my(%emails) = $sp->getEmailAddresses($id);
my $bestDate = '0001-01-01';
foreach my $possibleEmail (keys %emails) {
# There is a bug in $sp->getEmailAddresses() whereby it's returning a blank row; I don't know why, but that's why this next line is here:
next if ( (not defined $possibleEmail) or ($possibleEmail =~ /^\s*$/));
push(@emails, $possibleEmail);
print STDERR "$emails{$email}{date_encountered} gt $bestDate\n";
use Data::Dumper;
# print STDERR "$emails{$possibleEmail}{date_encountered} gt $bestDate\n", Data::Dumper->Dump([ \$possibleEmail, $emails{$possibleEmail} ]);
if ($emails{$possibleEmail}{date_encountered} gt $bestDate) {
$email = $possibleEmail; $bestDate = $emails{$possibleEmail}{date_encountered};
}
@ -131,15 +219,17 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
}
print STDERR "Supporter $id has no email address\n" if not defined $email;
my($specificRequest2018, $specificRequest2021) = (0, 0);
my($specificRequest2018, $specificRequest2021, $specificRequest2022) = (0, 0, 0);
my $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2018design-0' });
$specificRequest2018 = (defined $request);
$request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2021design-0' });
$specificRequest2021 = (defined $request);
my $bestPostal;
$request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-cy2022design-0' });
$specificRequest2022 = (defined $request);
my %bestPostal;
my $remainingQualifyingDonations = $requestData{$id}{total};
next if $remainingQualifyingDonations < 60.00; # Must have given at least $60 to get a shirt.
next if $remainingQualifyingDonations < $GIVING_LIMIT; # Must have given at least $GIVING_LIMIT to get a shirt.
my $outputSoFar = "$id:\n" . " oldest request: $requestData{$id}{oldestShirtDate}\n" .
" lastGave: $requestData{$id}{lastGaveDate}\n" .
" total: " . sprintf('%8.2f', $requestData{$id}{total}) ."\n" .
@ -152,15 +242,21 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
foreach my $type (sort { $requestData{$id}{shirts}{$a}{requestDate} cmp $requestData{$id}{shirts}{$b}{requestDate} } keys %{$requestData{$id}{shirts}}) {
my $outputType = $type;
my $size = $requestData{$id}{shirts}{$type}{requestConfiguration};
my $requestDate = $requestData{$id}{shirts}{$type}{requestDate};
print STDERR "Processing: $id, $type, $size, $requestDate\n" if $VERBOSE >= 1;
die "$id $type request has no size!" unless defined $size;
last if $remainingQualifyingDonations < 60.00;
$remainingQualifyingDonations -= 60.00;
if ($type !~ /(2018|2021|vintage)/) {
last if $remainingQualifyingDonations < $GIVING_LIMIT;
$remainingQualifyingDonations -= $GIVING_LIMIT;
if ($type !~ /(2018|2021|2022|vintage)/) {
$outputType = 'any';
} elsif ($type =~ /2018/) {
$outputType = '2018design';
} elsif ($type =~ /2021/) {
$outputType = '2021design';
} elsif ($type =~ /2022/) {
$outputType = '2022design';
} elsif ($type =~ /2023/) {
$outputType = '2023design';
} elsif ($type =~ /vintage/) {
$outputType = 'vintage';
}
@ -186,40 +282,79 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
die "Supporter $id: $outputType: $type: $size: invalid size \"$size\""
unless ($outputType ne 'any' and defined $sizeCounts->{$outputType}{$size})
or ($outputType eq 'any' and defined $sizeCounts->{vintage}{$size});
if ($outputType eq 'vintage' and $sizeCounts->{vintage}{$size} <= 0
and defined $sizeCounts->{'vintage-green'} and $sizeCounts->{'vintage-green'}{$size} > 0) {
$outputType = 'vintage-green';
} elsif ($outputType eq 'any' and $specificRequest2021 and $specificRequest2018) {
$outputType = 'vintage';
} elsif ($outputType eq 'any' and $specificRequest2018) {
$outputType = '2021design';
} elsif ($outputType eq 'any' and $specificRequest2021) {
# When fixing this, note that If folks got *any* shirt recently (since
# 2022-10-15), then they were told they would get the cy2022 design next,
# so favor giving them that one for any non-specific request
# if ($outputType eq 'vintage' and $sizeCounts->{vintage}{$size} <= 0
# and defined $sizeCounts->{'vintage-green'} and $sizeCounts->{'vintage-green'}{$size} > 0) {
# $outputType = 'vintage-green';
# } elsif ($outputType eq 'any' and (not $specificRequest2022)) {
# # Latter dates are for people who just never got a 2018
# if ($sizeCounts->{'2018design'}{$size} > 0 and (not $specificRequest2018)) {
# $outputType = '2018design';
# } else {
# $outputType = '2022design';
# }
# } elsif ($outputType eq 'any' and (not $specificRequest2021) and $requestDate gt '2020-03-01' and $requestDate lt '2021-01-01') {
# $outputType = '2021design';
# } elsif ($outputType eq 'any' and $specificRequest2021 and $specificRequest2018 and (not $specificRequest2022)) {
# $outputType = '2022design';
# } elsif ($outputType eq 'any' and $specificRequest2021 and $sizeCounts->{'2018design'}{$size} > 0) {
# $outputType = '2018design';
# } elsif ($outputType eq 'any' and $sizeCounts->{vintage}{$size} > 0
# and ($specificRequest2021 or ($sizeCounts->{'2021design'}{$size} < 2
# and $size =~ /^\s*(Men)\s*[LM]\s*$/))) {
# $outputType = 'vintage';
# } elsif ($outputType eq 'any' and $sizeCounts->{'2018design'}{$size} > 0 and (not $specificRequest2018)) {
# $outputType = '2018design';
# } elsif ($outputType eq 'any' and $specificRequest2018 and $sizeCounts->{'2021design'}{$size} > 0) {
# $outputType = '2021design';
# } elsif ($outputType eq 'any') {
# foreach my $reType (qw/2022design vintage-green vintage 2018design 2021design/) {
# if ($sizeCounts->{$reType}{$size} > 0 or $reType eq '2022design') {
# print "$id: bkuhn Using $outputType request as $reType\n";
# $outputType = $reType;
# last;
# }
# }
# }
# if ($outputType ne 'any' and $sizeCounts->{$outputType}{$size} < 0) {
# die "Somehow size count for $outputType, $size got to be less than zero!!!";
# } elsif ($outputType eq 'any' or $sizeCounts->{$outputType}{$size} == 0) {
if ($outputType =~ /any/ and (not $specificRequest2022)) {
$outputType = '2022design';
} elsif ($outputType =~ /2018/) {
$outputType = '2018design';
} elsif ($outputType eq 'any') {
foreach my $reType (qw/2021design 2018design vintage-green vintage/) {
if ($sizeCounts->{$reType}{$size} > 0) {
print "$id: bkuhn Using $outputType request as $reType\n";
$outputType = $reType;
last;
} elsif ($outputType =~ /2021/) {
$outputType = '2021design';
} elsif ($outputType eq 'any' and (not $specificRequest2018) and $sizeCounts->{'2018design'}{$size} > 0) {
$outputType = '2018design';
} elsif ($outputType eq 'any' and (not $specificRequest2021) and $sizeCounts->{'2021design'}{$size} > 0) {
$outputType = '2021design';
} elsif ($outputType eq 'any' and $sizeCounts->{vintage}{$size} > 0) {
$outputType = 'vintage';
} elsif ($outputType eq 'any' and $specificRequest2018 and $specificRequest2021 and $specificRequest2022) {
$outputType = 'HAVETHEMALLANDWANTMORE';
}
}
}
if ($outputType ne 'any' and $sizeCounts->{$outputType}{$size} < 0) {
die "Somehow size count for $outputType, $size got to be less than zero!!!";
} elsif ($outputType eq 'any' or $sizeCounts->{$outputType}{$size} == 0) {
print "KAREN output $outputType\n" if $id == 34;
if ($outputType eq 'any' or $sizeCounts->{$outputType}{$size} == 0) {
print "SKIP: $id $outputType $size\n";
$need{$outputType}{$size} = 0 unless defined $need{$outputType}{$size};
$need{$outputType}{$size}++;
next;
}
$bestPostal = $sp->getBestPostalAddress($id);
unless (defined $bestPostal) {
my $bb = $sp->getBestPostalAddress($id);
unless (defined $bb) {
warn "Supporter $id: unable to find best postal address!";
next;
}
%bestPostal = %$bb;
my $likelyUSA = 1
if ($idsKnownToBeInUSA{$id} or ($bestPostal =~ /United\s*States|USA|,\s*\S+\s+\d{5,5}(\s+|$)|,\s*\S+\s+\d{5,5}\-\d{4,4}(\s+|$)/mi
and (not $bestPostal =~ /Saudi\s*Arabia|France|Sweden|Uruguay|Bulgaria|Indonesia|Switzerland|Spain|Brasil|Brazil|Estonia|Germany|Bosnia|Herzegovina|Italy|Czech|Finland|Korea|Ireland|Israel/im)));
if (not $likelyUSA and $bestPostal =~ /Russia/im) {
if (not NotBlank($bestPostal{country}) or $bestPostal{country} =~ /^\s*U\s*S\s*A?/i);
if (not $likelyUSA and $bestPostal{country} =~ /Russia/im) {
warn "Support $id: CANNOT CURRENTLY SHIP TO RUSSIA";
next;
}
@ -235,18 +370,35 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
$requestDates .= $requestData{$id}{shirts}{$type}{requestDate};
# Order ID (required),Order Date,Order Value,Requested Service,Ship To - Name,Ship To - Company,Ship To - Address 1,Ship To - Address 2,Ship To - Address 3,Ship To - State/Province,Ship To - City,Ship To - Postal Code,Ship To - Country,Ship To - Phone,Ship To - Email,Total Weight in Oz,Dimensions - Length,Dimensions - Width,Dimensions - Height,Notes - From Customer,Notes - Internal,Gift Wrap?,Gift Message
my $orderID = $outputType . '_' . $size . '_' . $requestData{$id}{shirts}{$type}{requestDate} . '_' . sprintf("%4.4d", $id);
my $orderID = "";
$orderID .= $ORDER_PREFIX . "_" if defined $ORDER_PREFIX;
$orderID .= sprintf("%5.5d", $orderNum++) . '_' . $outputType . '_' . $size . '_' .
$requestData{$id}{shirts}{$type}{requestDate} . '_' . sprintf("%4.4d", $id);
# Yes, I thought about the Supporter 9999 problem here,
# Frankly, if we're still using this script when we
# have 10,000+ entries in supporters.db, I sure hope
# I'm already dead. -- bkuhn
$orderID =~ s/\s*//;
my $outputAddress = join(" ", split /\n/, $bestPostal);
$outputAddress = $bestPostal;
my $name = "";
foreach my $key (qw/first_name middle_name last_name/) {
$name .= ( ($name eq "") ? $bestPostal{$key} : (" " . $bestPostal{$key}) )
if defined $bestPostal{$key} and NotBlank($bestPostal{$key});
}
if ($likelyUSA) {
push(@usaRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate},
sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email,
"USA", $outputAddress ] );
push(@usaRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, $T_SHIRT_VALUE, "Domestic USPS Large Envelope",
$name, $bestPostal{company}, $bestPostal{address_1}, $bestPostal{address_2}, $bestPostal{address_3},
$bestPostal{state_province_or_region}, $bestPostal{city}, $bestPostal{postcode}, $bestPostal{country},
undef, $email, $WEIGHTS{$outputType}{$size}, 13, 2, 10,
undef, sprintf('%s_%s_%4.4d', $size, $outputType, $id), undef, undef ]);
# Yes, I thought about the Supporter 9999 problem here, # Frankly, if we're still using this
# script when we have 10,000+ entries in supporters.db, I sure hope I'm already dead. -- bkuhn
} else {
push(@intRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate},
sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email,
"International", $outputAddress ] );
push(@intRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, $T_SHIRT_VALUE, "International Large Envelope",
($name . " - " . $outputType . " $size"),
$bestPostal{company}, $bestPostal{address_1}, $bestPostal{address_2}, $bestPostal{address_3},
$bestPostal{state_province_or_region}, $bestPostal{city}, $bestPostal{postcode}, $bestPostal{country},
undef, $email, $WEIGHTS{$outputType}{$size}, 13, 2, 10,
undef, sprintf('%s_%s_%4.4d', $size, $outputType, $id), undef, undef ]);
}
}
next if $requestDates eq "";
@ -261,7 +413,10 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
print "\n Request Dates: $requestDates\n";
print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n";
print " Display name: \"", $sp->getDisplayName($id), "\"\n";
print " Postal Address:\n$bestPostal\n";
print " Postal Address:\n";
foreach my $key (keys %bestPostal) {
print " $key: $bestPostal{$key}\n" if (defined $bestPostal{$key} and NotBlank($bestPostal{$key}));
}
}
BeancountQueryComplete();
@ -293,20 +448,33 @@ if (defined $sizeCounts) {
print " ... includes subtotal of $type: $subtotals{$type}\n";
}
}
open my $usaFH, ">:encoding(utf8)", "usa.csv";
open my $intFH, ">:encoding(utf8)", "international.csv";
my $usaCSV = Text::CSV->new({ binary => 1, quote_char => '"', allow_whitespace => 1, always_quote => 1,
sep_char => ',', escape_char => "\\", auto_diag => 2, diag_verbose => 2 });
my $intCSV = Text::CSV->new({ binary => 1, quote_char => '"', allow_whitespace => 1, always_quote => 1,
sep_char => ',', escape_char => "\\", auto_diag => 2, diag_verbose => 2 });
my @headers = qw/orderId orderDate myReference size email usaOrInt formattedAddress/;
$usaCSV->say($usaFH, \@headers);
$intCSV->say($intFH, \@headers);
$usaCSV->say($usaFH, $_) for @usaRows; close $usaFH;
$intCSV->say($intFH, $_) for @intRows; close $intFH;
open my $usaFH, ">:encoding(utf8)", "first-pass_usa.csv";
open my $intFH, ">:encoding(utf8)", "first-pass_international.csv";
# This final loop is needed because I couldn't figure out how to make Text::CSV output undefs as ,"", instead ,,
# my %correctUndefs;
# $correctUndefs{usa} = []; $correctUndefs{int} = [];
# foreach my $type (qw/usa int/) {
# my(@topRows);
# if ($type eq 'usa') { @topRows = @usaRows; } elsif ($type eq 'int') { @topRows = @intRows; }
# foreach my $row (@topRows) {
# my @newRow;
# foreach my $item (@$row) {
# if (not defined $item) { push(@newRow, ""); } else { push(@newRow, $item); }
# }
# push(@{$correctUndefs{$type}}, \@newRow);
# }
# }
my $csvOutFormat = Text::CSV->new({ binary => 1, always_quote => 1, quote_empty => 1, blank_is_undef => 1});
#my $intCSV = Text::CSV->new({ binary => 1, quote_char => '"', allow_whitespace => 1, always_quote => 1,
# sep_char => ',', escape_char => "\\", auto_diag => 2, diag_verbose => 2 });
$csvOutFormat->say($usaFH, \@headerFields);
$csvOutFormat->say($intFH, \@headerFields);
$csvOutFormat->say($usaFH, $_) for @usaRows; close $usaFH;
$csvOutFormat->say($intFH, $_) for @intRows; close $intFH;
#$csvOutFormat->say($usaFH, $_) for @{$correctUndefs{usa}}; close $usaFH;
#$csvOutFormat->say($intFH, $_) for @{$correctUndefs{int}}; close $intFH;
exit 0;
###############################################################################
#
# Local variables:

156
sql/supporters-schema.sql
View file

@ -53,8 +53,8 @@ DROP TABLE IF EXISTS "request_hold";
CREATE TABLE "request_hold" (
"id" integer NOT NULL PRIMARY KEY,
"request_id" integer NOT NULL,
"hold_date" TEXT NOT NULL,
"release_date" TEXT,
"hold_date" date NOT NULL,
"release_date" date,
"who" varchar(300) NOT NULL,
"why" TEXT
);
@ -171,6 +171,127 @@ CREATE UNIQUE INDEX donor_postal_address_mapping_single_open_ended_addr
-- Note: CREATE TEMP TABLE doesn't work in BEGIN/END block of a CREATE TRIGGER, and as such, we have to create
-- all the temp tables as real tables.
-- -------------- VIEW: UserOperation_add_request ---------------------
DROP VIEW IF EXISTS UserOperation_add_shirt_request;
CREATE VIEW UserOperation_add_shirt_request AS
SELECT NULL as donor_id, rt.type as request_type, rc.description as request_detail, rt.id as type_id, rc.id as detail_id
FROM request_configuration rc, request_type rt
WHERE rt.type LIKE '%shirt%' AND
rc.request_type_id = rt.id
ORDER BY rt.type, rc.description;
DROP TRIGGER IF EXISTS add_shirt_request;
CREATE TRIGGER add_shirt_request
INSTEAD OF UPDATE OF donor_id ON UserOperation_add_shirt_request
BEGIN
SELECT CASE
WHEN ( (SELECT donor.id FROM donor WHERE id = NEW.donor_id) != NEW.donor_id )
THEN RAISE(FAIL, "Invalid donor ID; must enter a valid donor ID to add this shirt request.")
END;
SELECT CASE
WHEN ( (SELECT rr.id FROM donor dd, request rr WHERE rr.donor_id = dd.id AND dd.id = NEW.donor_id and rr.request_type_id = OLD.type_id) IS NOT NULL )
THEN RAISE(FAIL, "That donor already has a request of that type in the database; perhaps you wanted UserOperation_fix_tshirt_size_request instead of this view?")
END;
INSERT INTO request(donor_id, request_type_id, request_configuration_id, date_requested)
VALUES(NEW.donor_id, OLD.type_id, OLD.detail_id, date('now'));
END;
-- -------------- VIEW: UserOperation_fulfill_request_manually ---------------------
DROP VIEW IF EXISTS UserOperation_fulfill_request_manually;
CREATE VIEW UserOperation_fulfill_request_manually AS
SELECT donor.ledger_entity_id as entity, NULL as fulfill_how,
request_type.type as shirt_requested, request_configuration.description as size_requested,
request.date_requested as request_date, request.notes as note,
donor.id as donor_id, request.id as request_id
FROM donor, request_configuration, request, request_type
LEFT OUTER JOIN fulfillment ON fulfillment.request_id = request.id
WHERE request.id NOT IN (select request_id from fulfillment) AND
request_type.type LIKE '%shirt%' AND
request_type.id = request.request_type_id AND
request.donor_id = donor.id AND
request_configuration.id = request.request_configuration_id
ORDER BY request.date_requested DESC, donor.ledger_entity_id;
DROP TRIGGER IF EXISTS fulfill_request_manually;
CREATE TRIGGER fulfill_request_mannually
INSTEAD OF UPDATE OF fulfill_how on UserOperation_fulfill_request_manually
BEGIN
SELECT CASE
WHEN ( (SELECT rh.id FROM request_hold rh
WHERE rh.request_id = OLD.request_id
AND rh.release_date > date('now') )
IS NOT NULL )
THEN RAISE(FAIL, "Request is on hold; cannot fulfill; use UserOperation_unhold_request to unhold this request *first*!")
END;
INSERT INTO fulfillment(request_id, who, how, date)
VALUES(OLD.request_id, 'gui-edit', NEW.fulfill_how , date('now'));
END;
-- -------------- VIEW: UserOperation_fulfillment_failure ---------------------
DROP VIEW IF EXISTS UserOperation_fulfillment_failure;
CREATE VIEW UserOperation_fulfillment_failure AS
SELECT donor.ledger_entity_id as entity, fulfillment.date as fulfill_date,
request_type.type as shirt_requested, request_configuration.description as size_requested,
request.date_requested as request_date, request.notes as note,
fulfillment.who as fulfill_who, fulfillment.how as fulfill_how,
donor.id as donor_id, request.id as request_id, fulfillment.id as fulfill_id
FROM donor, request_configuration, request, request_type, fulfillment
WHERE request.id in (select request_id from fulfillment) AND
request_type.type LIKE '%shirt%' AND
request_type.id = request.request_type_id AND
request.donor_id = donor.id AND
request_configuration.id = request.request_configuration_id AND
fulfillment.request_id = request.id
ORDER BY fulfillment.date DESC, request.date_requested, donor.ledger_entity_id;
DROP TRIGGER IF EXISTS fulfillment_failure;
CREATE TRIGGER fulfillment_failure
INSTEAD OF UPDATE OF fulfill_how on UserOperation_fulfillment_failure
BEGIN
INSERT INTO request_hold(request_id, who, why, release_date, hold_date)
VALUES(OLD.request_id, "gui-edit",
(select 'because ' || NEW.fulfill_how || ', fulfillment failed (prev attempted via '
|| OLD.fulfill_how || ' by ' || OLD.fulfill_who || ' on ' || OLD.fulfill_date || ')'),
"9999-12-31", date('now'));
DELETE from fulfillment where id = OLD.fulfill_id;
END;
-- -------------- VIEW: UserOperation_unhold_request ---------------------
DROP VIEW IF EXISTS UserOperation_unhold_request;
CREATE VIEW UserOperation_unhold_request AS
SELECT donor.ledger_entity_id as entity, rh.release_date as release_date, rh.hold_date as held_date, rh.why as held_why, rh.who as held_who,
request_type.type as shirt_requested, request_configuration.description as size_requested,
request.date_requested as request_date, request.notes as note,
donor.id as donor_id, request.id as request_id, rh.id as held_id
FROM donor, request_configuration, request, request_type, request_hold rh
WHERE request.id in (select request_id from request_hold) AND
request.id NOT IN (select request_id from fulfillment) AND
request_type.type LIKE '%shirt%' AND
request_type.id = request.request_type_id AND
request.donor_id = donor.id AND
request_configuration.id = request.request_configuration_id AND
rh.request_id = request.id
ORDER BY rh.release_date DESC, rh.hold_date DESC, request.date_requested, donor.ledger_entity_id;
DROP TRIGGER IF EXISTS release_hold;
CREATE TRIGGER release_hold
INSTEAD OF UPDATE OF release_date on UserOperation_unhold_request
BEGIN
UPDATE request_hold set release_date = NEW.release_date WHERE id = OLD.held_id;
END;
-- -------------- VIEW: UserOperation_update_email_address ---------------------
DROP VIEW IF EXISTS UserOperation_email_add_when_none;
CREATE VIEW UserOperation_email_add_when_none AS
@ -209,6 +330,7 @@ END;
DROP TRIGGER IF EXISTS update_postal_address_preferred_override;
DROP TRIGGER IF EXISTS update_postal_address_is_invalid;
DROP TRIGGER IF EXISTS update_formatted_postal_address;
DROP VIEW IF EXISTS UserOperation_add_postal_for_donor_with_none;
DROP VIEW IF EXISTS UserOperation_postal_address_change;
CREATE VIEW UserOperation_postal_address_change AS
@ -241,15 +363,16 @@ INSERT INTO postal_address(first_name, middle_name, last_name, organization, add
VALUES(NEW.donor_id, (SELECT last_insert_rowid()), 21, date("now"));
-- VALUES(OLD.donor_id, (SELECT new_postal_address_id FROM wt) );
SELECT CASE
WHEN ( (SELECT address_1 FROM donor_postal_address_mapping dp, postal_address pa
WHERE dp.donor_id = NEW.donor_id
AND pa.id = (SELECT last_insert_rowid() )
AND dp.postal_address_id = (SELECT last_insert_rowid() )
AND pa.address_1 = NEW.addr1
!= NEW.addr1 ) )
THEN RAISE(FAIL, "Error encountered while adding new postal address; please verify your changes worked!")
END;
--- FIXME: Below doesn't work in sqlitebrowser, still don't know why
-- SELECT CASE
-- WHEN ( (SELECT address_1 FROM donor_postal_address_mapping dp, postal_address pa
-- WHERE dp.donor_id = NEW.donor_id
-- AND pa.id = (SELECT last_insert_rowid() )
-- AND dp.postal_address_id = (SELECT last_insert_rowid() )
-- AND pa.address_1 = NEW.addr1
-- != NEW.addr1 ) )
-- THEN RAISE(FAIL, "Error encountered while adding new postal address; please verify your changes worked!")
-- END;
END;
@ -291,12 +414,21 @@ CREATE VIEW UserOperation_fix_tshirt_size_request AS
request.date_requested as request_date, request.notes as note, donor.id as donor_id, request.id as request_id
FROM donor, request_configuration, request, request_type
WHERE request.id not in (select request_id from fulfillment) AND
request_type.type LIKE "%shirt%" AND
request_type.type LIKE '%shirt%' AND
request_type.id = request.request_type_id AND
request.donor_id = donor.id AND
request_configuration.id = request.request_configuration_id
ORDER BY donor.ledger_entity_id, request.date_requested;
DROP TRIGGER IF EXISTS fix_tshirt_size_note_updater;
CREATE TRIGGER fix_tshirt_size_note_updater
INSTEAD OF UPDATE OF note on UserOperation_fix_tshirt_size_request
BEGIN
UPDATE request set notes = NEW.note WHERE request.donor_id = OLD.donor_id and request.id = OLD.request_id;
END;
DROP TRIGGER IF EXISTS fix_tshirt_size_request_updater;
CREATE TRIGGER fix_tshirt_size_request_updater
INSTEAD OF UPDATE OF size_requested on UserOperation_fix_tshirt_size_request