Compare commits
No commits in common. "777c77baf96b69a2839118f8a27e2e2e70a28c5e" and "8f54ebb54c34df537dd6bcdc2888f3d57a0032b7" have entirely different histories.
777c77baf9
...
8f54ebb54c
6 changed files with 397 additions and 752 deletions
|
@ -812,33 +812,45 @@ Arguments:
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
Returns a hash that has the fields of the postal address from the database.
|
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.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub getBestPostalAddress($) {
|
sub getBestPostalAddress($) {
|
||||||
my($self, $id) = @_;
|
my($self, $id) = @_;
|
||||||
|
|
||||||
confess "getBestPostalAddress: invalid id, $id" unless $self->_verifyId($id);
|
die "Postal address stuff not fixed yet";
|
||||||
|
|
||||||
my $entries = $self->dbh()->selectall_hashref("SELECT pa.id, pa.first_name, pa.middle_name, pa.last_name, " .
|
die "getBestPostalAddress: invalid id, $id" unless $self->_verifyId($id);
|
||||||
"pa.organization, pa.address_1, pa.address_2, pa.address_3, " .
|
|
||||||
"pa.city, pa.state_province_or_region, pa.postcode, pa.country, " .
|
my $pref = $self->getPreferredPostalAddress($id);
|
||||||
"map.date_valid_from, at.name as type " .
|
|
||||||
"FROM donor_postal_address_mapping map, address_type at, postal_address pa " .
|
my $entries = $self->dbh()->selectall_hashref("SELECT pa.id, pa.formatted_address, at.name, pa.date_encountered " .
|
||||||
"WHERE at.id = map.type_id AND pa.id = map.postal_address_id AND " .
|
"FROM donor_postal_address_mapping map, address_type at, postal_address pa " .
|
||||||
" map.date_valid_to is NULL AND map.donor_id = " .
|
"WHERE at.id = map.type_id AND pa.id = map.postal_address_id AND " .
|
||||||
$self->dbh->quote($id, 'SQL_INTEGER'),
|
"(pa.invalid is NULL OR pa.invalid != 1) " .
|
||||||
|
"AND map.donor_id = " . $self->dbh->quote($id, 'SQL_INTEGER'),
|
||||||
'id');
|
'id');
|
||||||
if (keys %$entries <= 0) {
|
my $newest;
|
||||||
carp "getBestPostalAddress: unable to find postal address for id, $id";
|
my $otherSources = "";
|
||||||
return undef;
|
foreach my $pid (keys %{$entries}) {
|
||||||
} elsif (keys %$entries > 1) {
|
$newest = $entries->{$pid} unless defined $newest;
|
||||||
carp "getBestPostalAddress: multiple postal address with date_valid_to as NULL for id, $id";
|
if ($newest->{date_encountered} lt $entries->{$pid}{date_encountered}) {
|
||||||
return undef;
|
$newest = $entries->{$pid};
|
||||||
|
}
|
||||||
|
$otherSources .= " " . $entries->{$pid}{name} if defined $entries->{$pid}{name} and $entries->{$pid}{name} ne 'paypal';
|
||||||
}
|
}
|
||||||
my($pid) = keys(%$entries);
|
if (defined $pref and $newest->{formatted_address} ne $pref) {
|
||||||
return $entries->{$pid};
|
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};
|
||||||
}
|
}
|
||||||
######################################################################
|
######################################################################
|
||||||
|
|
||||||
|
@ -1137,12 +1149,12 @@ sub getRequest($$;$) {
|
||||||
my $requestTypeClause = "";
|
my $requestTypeClause = "";
|
||||||
if (defined $requestTypeId) {
|
if (defined $requestTypeId) {
|
||||||
$requestType = $self->_lookupRequestTypeById($requestTypeId);
|
$requestType = $self->_lookupRequestTypeById($requestTypeId);
|
||||||
confess "getRequest: invalid requestTypeId, \"$requestTypeId\"" unless defined $requestType;
|
die "getRequest: invalid requestTypeId, \"$requestTypeId\"" unless defined $requestType;
|
||||||
$requestTypeClause = " AND rt.id = " . $self->dbh->quote($requestTypeId, 'SQL_INTEGER');
|
$requestTypeClause = " AND rt.id = " . $self->dbh->quote($requestTypeId, 'SQL_INTEGER');
|
||||||
} elsif (defined $requestType) {
|
} elsif (defined $requestType) {
|
||||||
$requestTypeClause = " AND rt.type = " . $self->dbh->quote($requestType);
|
$requestTypeClause = " AND rt.type = " . $self->dbh->quote($requestType);
|
||||||
} else {
|
} else {
|
||||||
confess "getRequest: undefined requestType" unless defined $requestType;
|
die "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 " .
|
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 " .
|
"FROM request r, request_type rt WHERE r.request_type_id = rt.id AND " .
|
||||||
|
@ -1986,6 +1998,7 @@ sub _readLedgerData($) {
|
||||||
warn "Invalid line in line in ledgerFH output:\n $line"
|
warn "Invalid line in line in ledgerFH output:\n $line"
|
||||||
unless $line =~ /^\s*([^\d]+)\s+([\d\-]+)\s+(\S*)\s+\$?\s*(\-?\s*[\d,\.]+)\s*$/;
|
unless $line =~ /^\s*([^\d]+)\s+([\d\-]+)\s+(\S*)\s+\$?\s*(\-?\s*[\d,\.]+)\s*$/;
|
||||||
my($type, $date, $entityId, $amount) = ($1, $2, $3, $4);
|
my($type, $date, $entityId, $amount) = ($1, $2, $3, $4);
|
||||||
|
print STDERR "$type, $date, $entityId, $amount\n";
|
||||||
next unless defined $entityId and $entityId !~ /^\s*$/;
|
next unless defined $entityId and $entityId !~ /^\s*$/;
|
||||||
if (defined $self->{programTypeSearch}) {
|
if (defined $self->{programTypeSearch}) {
|
||||||
if ($type =~ /$self->{programTypeSearch}{annual}/) {
|
if ($type =~ /$self->{programTypeSearch}{annual}/) {
|
||||||
|
@ -1994,7 +2007,7 @@ sub _readLedgerData($) {
|
||||||
$type = 'Monthly';
|
$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);
|
$amount =~ s/,//; $amount = abs($amount);
|
||||||
if (defined $amountTable{$entityId}{donations}{$date}) {
|
if (defined $amountTable{$entityId}{donations}{$date}) {
|
||||||
$amountTable{$entityId}{donations}{$date} += $amount;
|
$amountTable{$entityId}{donations}{$date} += $amount;
|
||||||
|
|
|
@ -35,19 +35,7 @@ my $yearTot = 0.00;
|
||||||
my %specialContributions;
|
my %specialContributions;
|
||||||
foreach my $supporterId (@supporterIds) {
|
foreach my $supporterId (@supporterIds) {
|
||||||
my $expiresOn = $sp->supporterExpirationDate($supporterId);
|
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 $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) {
|
if (not $isLapsed) {
|
||||||
my $lastYearGave = $sp->donorTotalGaveInPeriod(donorId => $supporterId,
|
my $lastYearGave = $sp->donorTotalGaveInPeriod(donorId => $supporterId,
|
||||||
startDate => $ONE_YEAR_AGO, endDate => $TODAY);
|
startDate => $ONE_YEAR_AGO, endDate => $TODAY);
|
||||||
|
@ -65,7 +53,7 @@ my $activeCount = scalar(@supporterIds) - $lapsedCount;
|
||||||
print "\n\nWe have ", scalar(@supporterIds), " supporters and $lapsedCount are lapsed. That's ",
|
print "\n\nWe have ", scalar(@supporterIds), " supporters and $lapsedCount are lapsed. That's ",
|
||||||
sprintf("%.2f", $per), "%.\nActive supporter count: ", $activeCount, "\n";
|
sprintf("%.2f", $per), "%.\nActive supporter count: ", $activeCount, "\n";
|
||||||
|
|
||||||
print "\n\nTotal (non speical) Given in Year in last year by active supporters: ", sprintf("%.2f\n", $yearTot);
|
print "\n\nTotal (non speical) Given in Year in last year by active supoprters: ", sprintf("%.2f\n", $yearTot);
|
||||||
print "Average annual contribution by non-lapsed donors: ", sprintf("%.2f\n\n", $yearTot / $activeCount);
|
print "Average annual contribution by non-lapsed donors: ", sprintf("%.2f\n\n", $yearTot / $activeCount);
|
||||||
|
|
||||||
print "\n\nSpecial Contributions: \n" if (keys(%specialContributions) > 0);
|
print "\n\nSpecial Contributions: \n" if (keys(%specialContributions) > 0);
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
#!/usr/bin/perl
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use Time::HiRes qw(usleep nanosleep);
|
use Time::HiRes qw(usleep nanosleep);
|
||||||
|
@ -8,8 +10,6 @@ use File::Spec::Functions;
|
||||||
use autodie qw(:all);
|
use autodie qw(:all);
|
||||||
use DBI;
|
use DBI;
|
||||||
|
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
use Date::Manip::DM5;
|
use Date::Manip::DM5;
|
||||||
use Supporters;
|
use Supporters;
|
||||||
use Encode qw(encode decode);
|
use Encode qw(encode decode);
|
||||||
|
@ -19,39 +19,10 @@ use IPC::Shareable;
|
||||||
|
|
||||||
require 'bean-query-daemon-lib.pl';
|
require 'bean-query-daemon-lib.pl';
|
||||||
|
|
||||||
my $TOTAL_GROUPS = 1;
|
my $TOTAL_GROUPS = 2;
|
||||||
|
|
||||||
binmode STDOUT, ":utf8";
|
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 $encoder = Email::MIME::RFC2047::Encoder->new();
|
||||||
|
|
||||||
my $TODAY = UnixDate(ParseDate("today"), '%Y-%m-%d');
|
my $TODAY = UnixDate(ParseDate("today"), '%Y-%m-%d');
|
||||||
|
@ -66,77 +37,74 @@ 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_TWENTY_DAYS_AGO = UnixDate(ParseDate("320 days ago"), '%Y-%m-%d');
|
||||||
my $THREE_MONTHS_AGO = UnixDate(ParseDate("3 months 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 $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_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_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 $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_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 $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_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_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_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_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_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_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_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_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 $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 $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_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_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 $OCT_1_2020 = UnixDate(ParseDate("2020-10-01 08:00"), '%Y-%m-%d');
|
||||||
my $END_LAST_YEAR = '2020-12-31';
|
my $END_LAST_YEAR = '2020-12-31';
|
||||||
my $OCT_19_2021 = UnixDate(ParseDate("2021-10-19 08:00"), '%Y-%m-%d');
|
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_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_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) {
|
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";
|
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;
|
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;
|
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;
|
$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;
|
my %groupLines;
|
||||||
foreach my $group (1 .. $TOTAL_GROUPS) {
|
foreach my $group (1 .. $TOTAL_GROUPS) {
|
||||||
$groupLines{$group} = [];
|
$groupLines{$group} = [];
|
||||||
my %ff = ($group => "group-${group}$EMAIL_TEMPLATE_SUFFIX",
|
open(my $emailFH, "<", "group-${group}" . $EMAIL_TEMPLATE_SUFFIX);
|
||||||
"${group}-no-html", "no-html-group-${group}$EMAIL_TEMPLATE_SUFFIX");
|
binmode $emailFH, ":utf8";
|
||||||
foreach my $subgroup (sort keys %ff) {
|
|
||||||
open(my $emailFH, "<", $ff{$subgroup});
|
@{$groupLines{$group}} = <$emailFH>;
|
||||||
binmode $emailFH, ":utf8";
|
close $emailFH;
|
||||||
@{$groupLines{$subgroup}} = <$emailFH>;
|
|
||||||
close $emailFH;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
foreach my $group (($TOTAL_GROUPS+1) ... 999) {
|
foreach my $group (($TOTAL_GROUPS+1) ... 999) {
|
||||||
my $file = "group-${group}" . $EMAIL_TEMPLATE_SUFFIX;
|
my $file = "group-${group}" . $EMAIL_TEMPLATE_SUFFIX;
|
||||||
die "$file exists but you didn't include it in any groups" if -f $file;
|
die "$file exists but you didn't include it in any groups" if -f $file;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
my %skip = ();
|
my %skip = ();
|
||||||
sub update_skips {
|
sub update_skips {
|
||||||
my $skips = shift;
|
my $skips = shift;
|
||||||
my $source_filename = shift;
|
my $source_filename = shift;
|
||||||
open(my $skipFH, '<', $source_filename);
|
open(my $skipFH, '<', $source_filename) or
|
||||||
|
die "couldn't open skip file $source_filename: $!";
|
||||||
while (my $email = <$skipFH>) {
|
while (my $email = <$skipFH>) {
|
||||||
next if $email =~ /^\s*#/;
|
|
||||||
chomp $email;
|
chomp $email;
|
||||||
$skips->{$email} = $source_filename;
|
$skips->{$email} = $source_filename;
|
||||||
}
|
}
|
||||||
|
@ -145,30 +113,13 @@ sub update_skips {
|
||||||
if (defined $BAD_ADDRESS_LIST_FILE) {
|
if (defined $BAD_ADDRESS_LIST_FILE) {
|
||||||
update_skips(\%skip, $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;
|
my %groupCounts;
|
||||||
for my $ii (0 .. $TOTAL_GROUPS) { $groupCounts{$ii} = 0; }
|
for my $ii (0 .. $TOTAL_GROUPS) { $groupCounts{$ii} = 0; }
|
||||||
|
|
||||||
my(@supporterIds) = $sp->findDonor({});
|
my(@supporterIds) = $sp->findDonor({});
|
||||||
open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/',
|
open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/2021-12_Postcard',
|
||||||
'donor-ids-we-expect-are-probably-usa.txt'));
|
'donor-ids-in-usa.txt'));
|
||||||
my %idsKnownToBeInUSA;
|
my %idsKnownToBeInUSA;
|
||||||
while (my $idInUSA = <$idsInUSAFH>) {
|
while (my $idInUSA = <$idsInUSAFH>) {
|
||||||
chomp $idInUSA;
|
chomp $idInUSA;
|
||||||
|
@ -176,52 +127,60 @@ while (my $idInUSA = <$idsInUSAFH>) {
|
||||||
}
|
}
|
||||||
close $idsInUSAFH;
|
close $idsInUSAFH;
|
||||||
|
|
||||||
my $totalSupportersSent = 0;
|
|
||||||
|
|
||||||
MAIN_SUPPORTER_LOOP:
|
MAIN_SUPPORTER_LOOP:
|
||||||
foreach my $id (sort { $a <=> $b } @supporterIds) {
|
foreach my $id (sort { $a <=> $b } @supporterIds) {
|
||||||
next unless $sp->isSupporter($id);
|
next unless $sp->isSupporter($id);
|
||||||
my $donorType = lc($sp->getType($id));
|
my $donorType = lc($sp->getType($id));
|
||||||
my $expiresOn = $sp->supporterExpirationDate($id);
|
my $expiresOn = $sp->supporterExpirationDate($id);
|
||||||
my $isLapsed = ( (not defined $expiresOn) or $expiresOn lt $TODAY);
|
my $isLapsed = ( (not defined $expiresOn) or $expiresOn lt $TODAY);
|
||||||
|
|
||||||
my $amount = $sp->donorTotalGaveInPeriod(donorId => $id);
|
my $amount = $sp->donorTotalGaveInPeriod(donorId => $id);
|
||||||
my $lastGaveDate = $sp->donorLastGave($id);
|
my $lastGaveDate = $sp->donorLastGave($id);
|
||||||
my $firstGaveDate = $sp->donorFirstGave($id);
|
my $firstGaveDate = $sp->donorFirstGave($id);
|
||||||
my $nineMonthsSinceFirstGave = UnixDate(DateCalc(ParseDate($firstGaveDate), "+ 9 months"), '%Y-%m-%d');
|
my $nineMonthsSinceFirstGave = UnixDate(DateCalc(ParseDate($firstGaveDate), "+ 9 months"), '%Y-%m-%d');
|
||||||
|
|
||||||
# Compute "likely USA"
|
# Compute "likely USA"
|
||||||
my $likelyUSA = 0;
|
my $likelyUSA = 0;
|
||||||
my(%postalAddresses) = $sp->getPostalAddresses($id);
|
my $postalAddress = $sp->getPreferredPostalAddress($id);
|
||||||
|
my(@postalAddresses) = $sp->getPostalAddresses($id);
|
||||||
$likelyUSA = 1 if defined $idsKnownToBeInUSA{$id};
|
$likelyUSA = 1 if defined $idsKnownToBeInUSA{$id};
|
||||||
if (not $likelyUSA) {
|
if (not $likelyUSA) {
|
||||||
foreach my $pid (sort {$a <=> $b} keys %postalAddresses) {
|
foreach $postalAddress (@postalAddresses) {
|
||||||
my $postalAddress = $postalAddresses{$pid};
|
$likelyUSA = 1
|
||||||
if (defined $postalAddress and (not defined $postalAddress->{country} or $postalAddress->{country} =~ /^\s*$/ or
|
if (defined $postalAddress and
|
||||||
$postalAddress->{country} =~ /^\s*(United\s*States|U[\s\.]*S[\s\.]*A[\s\.]*|U\s*S)\s*$/mi)) {
|
$postalAddress =~ /United\s*States|USA|,\s*\S+\s+\d{5,5}(\s+|$)|,\s*\S+\s+\d{5,5}\-\d{4,4}(\s+|$)/mi
|
||||||
$likelyUSA = 1;
|
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;
|
my $group = 0;
|
||||||
my $specialContact = "";
|
my $specialContact = "";
|
||||||
my $annualRenewalText = " ";
|
if (not $sp->emailOk($id)) {
|
||||||
# if (not $sp->emailOk($id)) {
|
my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'});
|
||||||
# print "NOT-SENT: SUPPORTER $id: supporter is unsubscribed from mass emails.\n";
|
if (defined $req and defined $req->{requestConfiguration} and
|
||||||
# $groupCounts{0}++;
|
$req->{requestConfiguration} eq 'only-one-annual-renewal-notice') {
|
||||||
# next;
|
$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;
|
||||||
|
}
|
||||||
# Set up emails first in case we want to use it in the group tests below
|
# Set up emails first in case we want to use it in the group tests below
|
||||||
my %emails;
|
my %emails;
|
||||||
my $emailP = $sp->getPreferredEmailAddress($id);
|
my $email = $sp->getPreferredEmailAddress($id);
|
||||||
if (defined $emailP) {
|
if (defined $email) {
|
||||||
$emails{$emailP} = {};
|
$emails{$email} = {};
|
||||||
} else {
|
} else {
|
||||||
%emails = $sp->getEmailAddresses($id);
|
%emails = $sp->getEmailAddresses($id);
|
||||||
}
|
}
|
||||||
my @badEmails;
|
my @badEmails;
|
||||||
my $atLeastOneSkipHere = 0;
|
foreach $email (keys %emails) {
|
||||||
foreach my $email (keys %emails) {
|
|
||||||
if (defined $skip{$email}) {
|
if (defined $skip{$email}) {
|
||||||
$atLeastOneSkipHere = 1;
|
|
||||||
delete $emails{$email};
|
delete $emails{$email};
|
||||||
push(@badEmails, $email);
|
push(@badEmails, $email);
|
||||||
}
|
}
|
||||||
|
@ -229,111 +188,112 @@ foreach my $id (sort { $a <=> $b } @supporterIds) {
|
||||||
if (scalar(keys %emails) <= 0) {
|
if (scalar(keys %emails) <= 0) {
|
||||||
print "NOT-SENT: SUPPORTER $id: these email address(es) is/were bad: ",
|
print "NOT-SENT: SUPPORTER $id: these email address(es) is/were bad: ",
|
||||||
join(",", @badEmails), "\n";
|
join(",", @badEmails), "\n";
|
||||||
$group = 0; $groupCounts{$group}++;
|
$groupCounts{0}++;
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
my(@emails) = keys(%emails);
|
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";
|
if ($lastGaveDate ge $NOV_20_2020 and $lastGaveDate le $JAN_31_2021) {
|
||||||
$group = 0;
|
$group = 2;
|
||||||
$groupCounts{$group}++;
|
} elsif ($lastGaveDate ge $NOV_21_2021) {
|
||||||
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;
|
$group = 1;
|
||||||
} elsif ($lastGaveDate ge $NOV_2_2021 and $lastGaveDate le $JAN_15_2022) {
|
} elsif ($lastGaveDate lt $NOV_21_2021 or ($lastGaveDate gt $JAN_31_2021 and $lastGaveDate lt $NOV_20_2020)) {
|
||||||
$group = 1;
|
$groupCounts{-1} = 0 unless defined $groupCounts{-1};
|
||||||
} elsif ($lastGaveDate le $NOV_22_2022) {
|
$groupCounts{-1}++;
|
||||||
$group = 0; # Gave really really recently, don't send
|
# if (not $sp->emailOk($id)) {
|
||||||
$groupCounts{$group}++;
|
# my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'});
|
||||||
print "NOT-SENT: SUPPORTER $id: supporter gave too long ago, skipping\n";
|
# if (defined $req and defined $req->{requestConfiguration} and
|
||||||
next;
|
# $req->{requestConfiguration} eq 'only-one-annual-renewal-notice') {
|
||||||
} elsif ($lastGaveDate ge $JAN_16_2023) {
|
# $specialContact = 'only-one-annual-renewal-notice: ';
|
||||||
$group = 0; # Gave really really recently, don't send
|
# } else {
|
||||||
$groupCounts{$group}++;
|
# print "NOT-SENT: SUPPORTER $id: has requested no email contact\n";
|
||||||
print "NOT-SENT: SUPPORTER $id: supporter gave to recently, skipping.\n";
|
# $groupCounts{$group}++;
|
||||||
next;
|
# next;
|
||||||
} else {
|
# }
|
||||||
BeancountQueryComplete();
|
# }
|
||||||
|
# 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\"";
|
die "Supporter $id: not in a group, donor type \"$donorType\" who last gave on \"$lastGaveDate\"";
|
||||||
}
|
}
|
||||||
if ($group <= 0) {
|
if ($group <= 0) {
|
||||||
print "NOT-SENT: SUPPORTER $id: WARNING: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate, $firstGaveDate, $likelyUSA, @emails\n";
|
print "NOT-SENT: SUPPORTER $id: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate\n";
|
||||||
$groupCounts{0}++;
|
$groupCounts{0}++;
|
||||||
next;
|
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;
|
$expiresOn = "" if not defined $expiresOn;
|
||||||
my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
|
my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
|
||||||
$rtTicket = "" if not defined $rtTicket;
|
$rtTicket = "" if not defined $rtTicket;
|
||||||
$rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
|
$rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
|
||||||
foreach my $emailTo (@emails) {
|
print "SENT: SUPPORTER $id: Group $group: $specialContact", join(",", sort {$a cmp $b } @emails), "\n";
|
||||||
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);
|
open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDDRESS, '-oi', '-oem', '--',
|
||||||
binmode $sendmailFH, ":utf8";
|
@emails);
|
||||||
print $sendmailFH "To: $fullEmailLine\n";
|
binmode $sendmailFH, ":utf8";
|
||||||
$displayName = GetMostInformalName($sp, $id);
|
print $sendmailFH "To: $fullEmailLine\n";
|
||||||
foreach my $line (@{$groupLines{$thisEmailGroup}}) {
|
foreach my $line (@{$groupLines{$group}}) {
|
||||||
if (not defined $displayName or $displayName =~ /^\s*$/ ) {
|
die "no displayname for this item" if not defined $displayName or $displayName =~ /^\s*$/;
|
||||||
BeancountQueryComplete();
|
my $thisLine = $line; # Note: This is needed, apparently $line is by reference?
|
||||||
die "no displayname for this item";
|
$thisLine =~ s/FIXME_DISPLAYNAME/$displayName/g;
|
||||||
}
|
$thisLine =~ s/FIXME_SUPPORTER_ID/$id/g;
|
||||||
my $thisLine = $line; # Note: This is needed, apparently $line is by reference?
|
$thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
|
||||||
$thisLine =~ s/FIXME_DISPLAYNAME/$displayName/g;
|
print $sendmailFH $thisLine;
|
||||||
$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++;
|
close $sendmailFH;
|
||||||
print "SENT: SUPPORTER $id: Group $group: $specialContact", " Count: ", scalar(@emails), ": ";
|
usleep(70000);
|
||||||
my $moreThanOneEmail = 0;
|
$groupCounts{$group}++;
|
||||||
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";
|
print "\n\n";
|
||||||
my $totalSent = 0;
|
my $totalSent = 0;
|
||||||
foreach my $group (sort keys %groupCounts) {
|
foreach my $group (sort keys %groupCounts) {
|
||||||
print "TOTAL IN GROUP $group: $groupCounts{$group}\n";
|
print "TOTAL IN GROUP $group: $groupCounts{$group}\n";
|
||||||
no warnings 'numeric';
|
|
||||||
$totalSent += $groupCounts{$group} if $group > 0;
|
$totalSent += $groupCounts{$group} if $group > 0;
|
||||||
}
|
}
|
||||||
print "\n\nTOTAL EMAILS SENT: $totalSent\n";
|
print "\n\nTOTAL EMAILS SENT: $totalSent\n";
|
||||||
print "TOTAL SUPPORTERS SENT: $totalSupportersSent\n";
|
BeancountQueryComplete();
|
||||||
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";
|
|
||||||
|
|
||||||
###############################################################################
|
###############################################################################
|
||||||
#
|
#
|
||||||
|
|
|
@ -5,7 +5,6 @@ use warnings;
|
||||||
|
|
||||||
use autodie qw(:all);
|
use autodie qw(:all);
|
||||||
|
|
||||||
use Data::Dumper;
|
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use DBI;
|
use DBI;
|
||||||
use Encode qw(encode decode);
|
use Encode qw(encode decode);
|
||||||
|
@ -93,174 +92,159 @@ while (my $row = $csv->getline_hr($csvFH)) {
|
||||||
$row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
|
$row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
|
||||||
if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/);
|
if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/);
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
die "no reference1" if (not defined $row->{reference1} );
|
die "no reference1" if (not defined $row->{reference1} );
|
||||||
my $val = $row->{reference1};
|
my(@vals) = split(',', $row->{reference1});
|
||||||
die( "reference1 \"$row->{reference1}\" doesn't have an ID number on end, for shipment: " . Data::Dumper->Dump([$row]))
|
my $id = shift @vals;
|
||||||
unless $val =~ /^\s*(\S+)_(\d+)\s*$/;
|
$info{$id} = $row;
|
||||||
my($id, $shirt) = (int $2, $1);
|
|
||||||
$info{$id}{shirts} = {} unless defined $info{$id}{shirts};
|
|
||||||
|
|
||||||
my($size, $type) = split(/_+/, $shirt);
|
$info{$id}{shirts} = {}; $info{$id}{extras} = [];
|
||||||
if ($type =~ /2018/) {
|
foreach my $item (@vals) {
|
||||||
$type = 't-shirt-fy2018design-0';
|
if ($item =~ /\s*\++\s*(\S.*)$/) {
|
||||||
} elsif ($type =~ /vint/i) {
|
push(@{$info{$id}{extras}}, $1);
|
||||||
$type = 't-shirt-vintage-0';
|
next;
|
||||||
} elsif ($type =~ /2021/i) {
|
}
|
||||||
$type = 't-shirt-fy2021design-0';
|
my($size, $type) = split(/_+/, $item);
|
||||||
} elsif ($type =~ /2022/i) {
|
if ($type =~ /2018/) {
|
||||||
$type = 't-shirt-cy2022design-0';
|
$type = 't-shirt-fy2018design-0';
|
||||||
} else {
|
} elsif ($type =~ /vint/i) {
|
||||||
die "$type is not a known t-shirt type";
|
$type = 'vintage';
|
||||||
}
|
|
||||||
$info{$id}{shirts}{$type}{size} = $size;
|
|
||||||
$info{$id}{shirts}{$type}{row} = $row;
|
|
||||||
}
|
|
||||||
|
|
||||||
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}{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 $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 {
|
} else {
|
||||||
$service .= " was delivered on $row->{'date delivered'}";
|
die "$type is not a known t-shirt type";
|
||||||
$delivered = 1 if $row->{'status'} and $row->{'status'} =~ /eliver/i and not $row->{'status'} =~ /undeliv/i;
|
|
||||||
}
|
}
|
||||||
} else {
|
$info{$id}{shirts}{$type} = $size;
|
||||||
$service .= " was shipped";
|
|
||||||
$thisHow .= " shipped";
|
|
||||||
if (defined $row->{'ship date'} and $row->{'ship date'} !~ /^\s*$/) {
|
|
||||||
$service .= " on $row->{'ship date'}";
|
|
||||||
$thisHow .= " on $row->{'ship date'}";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
$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 $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 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."
|
|
||||||
}
|
|
||||||
$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) {
|
|
||||||
$emails{$email} = {};
|
|
||||||
} else {
|
|
||||||
%emails = $sp->getEmailAddresses($id);
|
|
||||||
}
|
|
||||||
my(@emails) = keys(%emails);
|
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
|
|
||||||
$rtTicket = "" if not defined $rtTicket;
|
|
||||||
$rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
|
|
||||||
push(@emails, 'supporters@tix.sfconservancy.org') if $rtTicket ne "";
|
|
||||||
open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDRESS, '-oi', '-oem', '--',
|
|
||||||
@emails);
|
|
||||||
binmode $sendmailFH, ":utf8";
|
|
||||||
print $sendmailFH "To: $fullEmailLine\n";
|
|
||||||
foreach my $line (@emailLines) {
|
|
||||||
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_SENT_INFO/$sentData/g;
|
|
||||||
$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) {
|
foreach my $id (sort 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 " }
|
||||||
|
|
||||||
|
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'}";
|
||||||
|
} else {
|
||||||
|
$service .= " was delivered on $info{$id}{'date delivered'}";
|
||||||
|
$delivered = 1 if $info{$id}{'status'} and $info{$id}{'status'} =~ /eliver/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'}";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$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'}";
|
||||||
|
}
|
||||||
|
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 #'}";
|
||||||
|
}
|
||||||
|
$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.";
|
||||||
|
$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 @requestTypes = $sp->getRequestType();
|
||||||
|
my $sizesSent;
|
||||||
my %need;
|
my %need;
|
||||||
foreach my $requestType (@requestTypes) {
|
foreach my $type (@requestTypes) {
|
||||||
my $request = $sp->getRequest({ donorId => $id, requestType => $requestType,
|
my $request = $sp->getRequest({ donorId => $id, requestType => $type,
|
||||||
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
|
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
|
||||||
if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
|
if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
|
||||||
$need{$request->{requestType}} = $request->{requestConfiguration} if $request->{requestType} =~ /^\s*t-shirt/;
|
$need{$type} = $request->{requestConfiguration} if $type =~ /^\s*t-shirt/;
|
||||||
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
foreach my $type (keys %{$info{$id}{shirts}}) {
|
my $cur = 't-shirt-fy2018design-0';
|
||||||
my $size = $info{$id}{shirts}{$type}{size};
|
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) {
|
foreach my $key (keys %need) {
|
||||||
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
|
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
|
||||||
if ($need{$key} eq $size and $type eq $key) {
|
if ($need{$key} eq $size) {
|
||||||
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
|
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $thisHow});
|
||||||
|
$sentData .= "A $size t-shirt in the vintage design. ";
|
||||||
delete $need{$key};
|
delete $need{$key};
|
||||||
delete $info{$id}{shirts}{$type};
|
delete $info{$id}{shirts}{$shirtType};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
foreach my $type (keys %{$info{$id}{shirts}}) {
|
foreach my $shirtType (keys %{$info{$id}{shirts}}) {
|
||||||
my $size = $info{$id}{shirts}{$type}{size};
|
my $size = $info{$id}{shirts}{$shirtType};
|
||||||
foreach my $key (keys %need) {
|
$sentData .= "A $size t-shirt in the $shirtType design that we included just becuase we thought you would like it. ";
|
||||||
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
|
}
|
||||||
if ($need{$key} eq $size and $key =~ /^t-shirt-(extra-)?[0123456789]/) {
|
foreach my $extra (sort { $a cmp $b} @{$info{$id}{extras}}) {
|
||||||
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
|
if ($extra =~ /PIN/) {
|
||||||
delete $need{$key};
|
$sentData .= " A pin from our our CopyleftConf 2019! ";
|
||||||
delete $info{$id}{shirts}{$type};
|
} else {
|
||||||
}
|
die "Supporter $id: unkown extra: $extra";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
foreach my $type (keys %{$info{$id}{shirts}}) {
|
my %emails;
|
||||||
print "WARNING: For $id, shirt of $type in size $info{$id}{shirts}{$type}{size} did not fulfill a request\n";
|
my $email = $sp->getPreferredEmailAddress($id);
|
||||||
|
if (defined $email) {
|
||||||
|
$emails{$email} = {};
|
||||||
|
} else {
|
||||||
|
%emails = $sp->getEmailAddresses($id);
|
||||||
}
|
}
|
||||||
|
my(@emails) = keys(%emails);
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
|
||||||
|
$rtTicket = "" if not defined $rtTicket;
|
||||||
|
$rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
|
||||||
|
push(@emails, 'supporters@tix.sfconservancy.org') if $rtTicket ne "";
|
||||||
|
open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDRESS, '-oi', '-oem', '--',
|
||||||
|
@emails);
|
||||||
|
binmode $sendmailFH, ":utf8";
|
||||||
|
print $sendmailFH "To: $fullEmailLine\n";
|
||||||
|
foreach my $line (@emailLines) {
|
||||||
|
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_SENT_INFO/$sentData/g;
|
||||||
|
$thisLine =~ s/FIXME_DELVIERY_STATUS_INFO/$deliveryStatus/g;
|
||||||
|
$thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
|
||||||
|
$thisLine =~ s/FIXME_POSTAL_SERVICE_INFO/$service/g;
|
||||||
|
|
||||||
|
print $sendmailFH $thisLine;
|
||||||
|
}
|
||||||
|
close $sendmailFH;
|
||||||
|
usleep(70000);
|
||||||
}
|
}
|
||||||
###############################################################################
|
###############################################################################
|
||||||
#
|
#
|
||||||
|
|
|
@ -5,110 +5,48 @@ use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
use autodie qw(open close chdir);
|
use autodie qw(open close chdir);
|
||||||
use Getopt::Long;
|
|
||||||
use DBI;
|
use DBI;
|
||||||
use Encode qw(encode decode);
|
use Encode qw(encode decode);
|
||||||
use Text::CSV; # libtext-csv-perl in Debian
|
use Text::CSV; # libtext-csv-perl in Debian
|
||||||
|
|
||||||
use YAML::XS qw(LoadFile);
|
use YAML::XS qw(LoadFile);
|
||||||
|
|
||||||
use File::Spec::Functions qw(rel2abs catfile);
|
|
||||||
|
|
||||||
use LaTeX::Encode;
|
use LaTeX::Encode;
|
||||||
|
|
||||||
use Supporters;
|
use Supporters;
|
||||||
use utf8;
|
use utf8;
|
||||||
use IPC::Shareable;
|
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';
|
require 'bean-query-daemon-lib.pl';
|
||||||
binmode STDOUT, ":utf8";
|
binmode STDOUT, ":utf8";
|
||||||
|
|
||||||
my($CONSERVANCY_REPOSITORY, $SUPPORTERS_SQLITE_DB_FILE, $VERBOSE, $SERIAL_ORDER_START, $ORDER_PREFIX,
|
BeancountQueryInitialize();
|
||||||
$T_SHIRT_VALUE, $GIVING_LIMIT, $T_SHIRT_STYLE, $SIZE_COUNT_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $GLUE) =
|
if (@ARGV < 8 or @ARGV > 9) {
|
||||||
($ENV{CONSERVANCY_REPOSITORY}, undef, 0, 0, undef,
|
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";
|
||||||
7, 60, undef, undef, '^Conservancy:Supporters:Monthly', '^Conservancy:Supporters:(?:Annual|Match\s*Pledge)', undef, undef);
|
exit 1;
|
||||||
|
}
|
||||||
|
|
||||||
sub UsageAndExit($) {
|
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;
|
||||||
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";
|
$VERBOSE = 0 if not defined $VERBOSE;
|
||||||
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');
|
|
||||||
|
|
||||||
if ($CONSERVANCY_REPOSITORY ne $ENV{CONSERVANCY_REPOSITORY} and not -d $CONSERVANCY_REPOSITORY) {
|
open(my $idsInUSAFH, "<", $ID_IN_USA_FILE);
|
||||||
UsageAndExit("provided --conservancyRepository is not a directory");
|
|
||||||
} elsif ($CONSERVANCY_REPOSITORY eq $ENV{CONSERVANCY_REPOSITORY} and not -d $CONSERVANCY_REPOSITORY) {
|
my %idsKnownToBeInUSA;
|
||||||
UsageAndExit("CONSERANCY_REPOSITORY from the environment variable, $ENV{CONSERANCY_REPOSITORY}, is not a directory. Use --conservancyRepository or change the environment variable.");
|
|
||||||
|
while (my $idInUSA = <$idsInUSAFH>) {
|
||||||
|
chomp $idInUSA;
|
||||||
|
$idsKnownToBeInUSA{$idInUSA} = 1;
|
||||||
}
|
}
|
||||||
$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(@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", "", "",
|
my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
|
||||||
{ RaiseError => 1, sqlite_unicode => 1 })
|
{ RaiseError => 1, sqlite_unicode => 1 })
|
||||||
or die $DBI::errstr;
|
or die $DBI::errstr;
|
||||||
|
|
||||||
BeancountQueryInitialize($GLUE);
|
|
||||||
my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
|
my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
|
||||||
SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
|
SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
|
||||||
WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
|
WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
|
||||||
|
@ -125,17 +63,8 @@ my %lines;
|
||||||
|
|
||||||
my @typeList;
|
my @typeList;
|
||||||
my @oldTypeList;
|
my @oldTypeList;
|
||||||
if ($T_SHIRT_STYLE eq 'ALL') {
|
if ($T_SHIRT_STYLE eq 'ONLY-fy2021design') {
|
||||||
@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/;
|
@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') {
|
} elsif ($T_SHIRT_STYLE eq 'fy2021design') {
|
||||||
@typeList = qw/t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
|
@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/;
|
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
|
||||||
|
@ -148,7 +77,7 @@ if ($T_SHIRT_STYLE eq 'ALL') {
|
||||||
@oldTypeList = qw/t-shirt-0 t-shirt-extra-0/;
|
@oldTypeList = qw/t-shirt-0 t-shirt-extra-0/;
|
||||||
@typeList = qw/t-shirt-1 t-shirt-extra-1/;
|
@typeList = qw/t-shirt-1 t-shirt-extra-1/;
|
||||||
} else {
|
} else {
|
||||||
UsageAndExit("--tShirtStyle must be a known t-shirt style setting; $T_SHIRT_STYLE is unknown");
|
die "Unknown t-shirt style given: $T_SHIRT_STYLE";
|
||||||
}
|
}
|
||||||
|
|
||||||
my %requestData;
|
my %requestData;
|
||||||
|
@ -167,19 +96,6 @@ foreach my $id (@supporterIds) {
|
||||||
$requestData{$id}{oldestShirtDate} = '9999-12-31' unless defined $requestData{$id}{oldestShirtDate};
|
$requestData{$id}{oldestShirtDate} = '9999-12-31' unless defined $requestData{$id}{oldestShirtDate};
|
||||||
$requestData{$id}{forSortingbySize} = "" unless defined $requestData{$id}{forSortingbySize};
|
$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}{shirts}{$request->{requestType}} = $request;
|
||||||
$requestData{$id}{forSortingbySize} = $request->{requestConfiguration}
|
$requestData{$id}{forSortingbySize} = $request->{requestConfiguration}
|
||||||
if ($requestData{$id}{forSortingbySize} eq "" and defined $request->{requestConfiguration});
|
if ($requestData{$id}{forSortingbySize} eq "" and defined $request->{requestConfiguration});
|
||||||
|
@ -188,28 +104,24 @@ foreach my $id (@supporterIds) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
sub sortFunction($$) { return (($requestData{$_[0]}{forSortingbyType} cmp $requestData{$_[1]}{forSortingbyType}) or
|
sub sortFunction($$) { return (($requestData{$_[1]}{total} <=> $requestData{$_[0]}{total}) or
|
||||||
|
($requestData{$_[1]}{lastGaveDate} cmp $requestData{$_[0]}{lastGaveDate}) or
|
||||||
($requestData{$_[0]}{oldestShirtDate} cmp $requestData{$_[1]}{oldestShirtDate}) or
|
($requestData{$_[0]}{oldestShirtDate} cmp $requestData{$_[1]}{oldestShirtDate}) or
|
||||||
($requestData{$_[0]}{forSortingbySize} cmp $requestData{$_[1]}{forSortingbySize}) 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]));
|
($_[0] <=> $_[1]));
|
||||||
}
|
}
|
||||||
my %need;
|
my %need;
|
||||||
my $orderNum = $SERIAL_ORDER_START;
|
|
||||||
foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
|
foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
|
||||||
print "KAREN\n" if $id == 34;
|
next if $id == 20 or $id == 70 or $id == 670 or $id == 34;
|
||||||
|
|
||||||
my $email = $sp->getPreferredEmailAddress($id);
|
my $email = $sp->getPreferredEmailAddress($id);
|
||||||
my @emails;
|
my @emails;
|
||||||
if (not defined $email) {
|
if (not defined $email) {
|
||||||
my(%emails) = $sp->getEmailAddresses($id);
|
my(%emails) = $sp->getEmailAddresses($id);
|
||||||
my $bestDate = '0001-01-01';
|
my $bestDate = '0001-01-01';
|
||||||
foreach my $possibleEmail (keys %emails) {
|
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);
|
push(@emails, $possibleEmail);
|
||||||
use Data::Dumper;
|
print STDERR "$emails{$email}{date_encountered} gt $bestDate\n";
|
||||||
# print STDERR "$emails{$possibleEmail}{date_encountered} gt $bestDate\n", Data::Dumper->Dump([ \$possibleEmail, $emails{$possibleEmail} ]);
|
|
||||||
if ($emails{$possibleEmail}{date_encountered} gt $bestDate) {
|
if ($emails{$possibleEmail}{date_encountered} gt $bestDate) {
|
||||||
$email = $possibleEmail; $bestDate = $emails{$possibleEmail}{date_encountered};
|
$email = $possibleEmail; $bestDate = $emails{$possibleEmail}{date_encountered};
|
||||||
}
|
}
|
||||||
|
@ -219,17 +131,15 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
|
||||||
}
|
}
|
||||||
print STDERR "Supporter $id has no email address\n" if not defined $email;
|
print STDERR "Supporter $id has no email address\n" if not defined $email;
|
||||||
|
|
||||||
my($specificRequest2018, $specificRequest2021, $specificRequest2022) = (0, 0, 0);
|
my($specificRequest2018, $specificRequest2021) = (0, 0);
|
||||||
|
|
||||||
my $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2018design-0' });
|
my $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2018design-0' });
|
||||||
$specificRequest2018 = (defined $request);
|
$specificRequest2018 = (defined $request);
|
||||||
$request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2021design-0' });
|
$request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2021design-0' });
|
||||||
$specificRequest2021 = (defined $request);
|
$specificRequest2021 = (defined $request);
|
||||||
$request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-cy2022design-0' });
|
my $bestPostal;
|
||||||
$specificRequest2022 = (defined $request);
|
|
||||||
my %bestPostal;
|
|
||||||
my $remainingQualifyingDonations = $requestData{$id}{total};
|
my $remainingQualifyingDonations = $requestData{$id}{total};
|
||||||
next if $remainingQualifyingDonations < $GIVING_LIMIT; # Must have given at least $GIVING_LIMIT to get a shirt.
|
next if $remainingQualifyingDonations < 60.00; # Must have given at least $60 to get a shirt.
|
||||||
my $outputSoFar = "$id:\n" . " oldest request: $requestData{$id}{oldestShirtDate}\n" .
|
my $outputSoFar = "$id:\n" . " oldest request: $requestData{$id}{oldestShirtDate}\n" .
|
||||||
" lastGave: $requestData{$id}{lastGaveDate}\n" .
|
" lastGave: $requestData{$id}{lastGaveDate}\n" .
|
||||||
" total: " . sprintf('%8.2f', $requestData{$id}{total}) ."\n" .
|
" total: " . sprintf('%8.2f', $requestData{$id}{total}) ."\n" .
|
||||||
|
@ -242,21 +152,15 @@ 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}}) {
|
foreach my $type (sort { $requestData{$id}{shirts}{$a}{requestDate} cmp $requestData{$id}{shirts}{$b}{requestDate} } keys %{$requestData{$id}{shirts}}) {
|
||||||
my $outputType = $type;
|
my $outputType = $type;
|
||||||
my $size = $requestData{$id}{shirts}{$type}{requestConfiguration};
|
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;
|
die "$id $type request has no size!" unless defined $size;
|
||||||
last if $remainingQualifyingDonations < $GIVING_LIMIT;
|
last if $remainingQualifyingDonations < 60.00;
|
||||||
$remainingQualifyingDonations -= $GIVING_LIMIT;
|
$remainingQualifyingDonations -= 60.00;
|
||||||
if ($type !~ /(2018|2021|2022|vintage)/) {
|
if ($type !~ /(2018|2021|vintage)/) {
|
||||||
$outputType = 'any';
|
$outputType = 'any';
|
||||||
} elsif ($type =~ /2018/) {
|
} elsif ($type =~ /2018/) {
|
||||||
$outputType = '2018design';
|
$outputType = '2018design';
|
||||||
} elsif ($type =~ /2021/) {
|
} elsif ($type =~ /2021/) {
|
||||||
$outputType = '2021design';
|
$outputType = '2021design';
|
||||||
} elsif ($type =~ /2022/) {
|
|
||||||
$outputType = '2022design';
|
|
||||||
} elsif ($type =~ /2023/) {
|
|
||||||
$outputType = '2023design';
|
|
||||||
} elsif ($type =~ /vintage/) {
|
} elsif ($type =~ /vintage/) {
|
||||||
$outputType = 'vintage';
|
$outputType = 'vintage';
|
||||||
}
|
}
|
||||||
|
@ -282,79 +186,40 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
|
||||||
die "Supporter $id: $outputType: $type: $size: invalid size \"$size\""
|
die "Supporter $id: $outputType: $type: $size: invalid size \"$size\""
|
||||||
unless ($outputType ne 'any' and defined $sizeCounts->{$outputType}{$size})
|
unless ($outputType ne 'any' and defined $sizeCounts->{$outputType}{$size})
|
||||||
or ($outputType eq 'any' and defined $sizeCounts->{vintage}{$size});
|
or ($outputType eq 'any' and defined $sizeCounts->{vintage}{$size});
|
||||||
|
if ($outputType eq 'vintage' and $sizeCounts->{vintage}{$size} <= 0
|
||||||
# When fixing this, note that If folks got *any* shirt recently (since
|
and defined $sizeCounts->{'vintage-green'} and $sizeCounts->{'vintage-green'}{$size} > 0) {
|
||||||
# 2022-10-15), then they were told they would get the cy2022 design next,
|
$outputType = 'vintage-green';
|
||||||
# so favor giving them that one for any non-specific request
|
} elsif ($outputType eq 'any' and $specificRequest2021 and $specificRequest2018) {
|
||||||
|
|
||||||
# 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 =~ /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';
|
$outputType = 'vintage';
|
||||||
} elsif ($outputType eq 'any' and $specificRequest2018 and $specificRequest2021 and $specificRequest2022) {
|
} elsif ($outputType eq 'any' and $specificRequest2018) {
|
||||||
$outputType = 'HAVETHEMALLANDWANTMORE';
|
$outputType = '2021design';
|
||||||
|
} elsif ($outputType eq 'any' and $specificRequest2021) {
|
||||||
|
$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;
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
print "KAREN output $outputType\n" if $id == 34;
|
if ($outputType ne 'any' and $sizeCounts->{$outputType}{$size} < 0) {
|
||||||
|
die "Somehow size count for $outputType, $size got to be less than zero!!!";
|
||||||
if ($outputType eq 'any' or $sizeCounts->{$outputType}{$size} == 0) {
|
} elsif ($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} = 0 unless defined $need{$outputType}{$size};
|
||||||
$need{$outputType}{$size}++;
|
$need{$outputType}{$size}++;
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
my $bb = $sp->getBestPostalAddress($id);
|
$bestPostal = $sp->getBestPostalAddress($id);
|
||||||
unless (defined $bb) {
|
unless (defined $bestPostal) {
|
||||||
warn "Supporter $id: unable to find best postal address!";
|
warn "Supporter $id: unable to find best postal address!";
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
%bestPostal = %$bb;
|
|
||||||
my $likelyUSA = 1
|
my $likelyUSA = 1
|
||||||
if (not NotBlank($bestPostal{country}) or $bestPostal{country} =~ /^\s*U\s*S\s*A?/i);
|
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
|
||||||
if (not $likelyUSA and $bestPostal{country} =~ /Russia/im) {
|
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) {
|
||||||
warn "Support $id: CANNOT CURRENTLY SHIP TO RUSSIA";
|
warn "Support $id: CANNOT CURRENTLY SHIP TO RUSSIA";
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
@ -370,35 +235,18 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
|
||||||
$requestDates .= $requestData{$id}{shirts}{$type}{requestDate};
|
$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
|
# 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 = "";
|
my $orderID = $outputType . '_' . $size . '_' . $requestData{$id}{shirts}{$type}{requestDate} . '_' . sprintf("%4.4d", $id);
|
||||||
$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*//;
|
$orderID =~ s/\s*//;
|
||||||
my $name = "";
|
my $outputAddress = join(" ", split /\n/, $bestPostal);
|
||||||
foreach my $key (qw/first_name middle_name last_name/) {
|
$outputAddress = $bestPostal;
|
||||||
$name .= ( ($name eq "") ? $bestPostal{$key} : (" " . $bestPostal{$key}) )
|
|
||||||
if defined $bestPostal{$key} and NotBlank($bestPostal{$key});
|
|
||||||
}
|
|
||||||
if ($likelyUSA) {
|
if ($likelyUSA) {
|
||||||
push(@usaRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, $T_SHIRT_VALUE, "Domestic USPS Large Envelope",
|
push(@usaRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate},
|
||||||
$name, $bestPostal{company}, $bestPostal{address_1}, $bestPostal{address_2}, $bestPostal{address_3},
|
sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email,
|
||||||
$bestPostal{state_province_or_region}, $bestPostal{city}, $bestPostal{postcode}, $bestPostal{country},
|
"USA", $outputAddress ] );
|
||||||
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 {
|
} else {
|
||||||
push(@intRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, $T_SHIRT_VALUE, "International Large Envelope",
|
push(@intRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate},
|
||||||
($name . " - " . $outputType . " $size"),
|
sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email,
|
||||||
$bestPostal{company}, $bestPostal{address_1}, $bestPostal{address_2}, $bestPostal{address_3},
|
"International", $outputAddress ] );
|
||||||
$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 "";
|
next if $requestDates eq "";
|
||||||
|
@ -413,10 +261,7 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
|
||||||
print "\n Request Dates: $requestDates\n";
|
print "\n Request Dates: $requestDates\n";
|
||||||
print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n";
|
print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n";
|
||||||
print " Display name: \"", $sp->getDisplayName($id), "\"\n";
|
print " Display name: \"", $sp->getDisplayName($id), "\"\n";
|
||||||
print " Postal Address:\n";
|
print " Postal Address:\n$bestPostal\n";
|
||||||
foreach my $key (keys %bestPostal) {
|
|
||||||
print " $key: $bestPostal{$key}\n" if (defined $bestPostal{$key} and NotBlank($bestPostal{$key}));
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
BeancountQueryComplete();
|
BeancountQueryComplete();
|
||||||
|
|
||||||
|
@ -448,33 +293,20 @@ if (defined $sizeCounts) {
|
||||||
print " ... includes subtotal of $type: $subtotals{$type}\n";
|
print " ... includes subtotal of $type: $subtotals{$type}\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
open my $usaFH, ">:encoding(utf8)", "first-pass_usa.csv";
|
open my $usaFH, ">:encoding(utf8)", "usa.csv";
|
||||||
open my $intFH, ">:encoding(utf8)", "first-pass_international.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;
|
||||||
|
|
||||||
# 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:
|
# Local variables:
|
||||||
|
|
|
@ -53,8 +53,8 @@ DROP TABLE IF EXISTS "request_hold";
|
||||||
CREATE TABLE "request_hold" (
|
CREATE TABLE "request_hold" (
|
||||||
"id" integer NOT NULL PRIMARY KEY,
|
"id" integer NOT NULL PRIMARY KEY,
|
||||||
"request_id" integer NOT NULL,
|
"request_id" integer NOT NULL,
|
||||||
"hold_date" date NOT NULL,
|
"hold_date" TEXT NOT NULL,
|
||||||
"release_date" date,
|
"release_date" TEXT,
|
||||||
"who" varchar(300) NOT NULL,
|
"who" varchar(300) NOT NULL,
|
||||||
"why" TEXT
|
"why" TEXT
|
||||||
);
|
);
|
||||||
|
@ -171,127 +171,6 @@ 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
|
-- 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.
|
-- 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 ---------------------
|
-- -------------- VIEW: UserOperation_update_email_address ---------------------
|
||||||
DROP VIEW IF EXISTS UserOperation_email_add_when_none;
|
DROP VIEW IF EXISTS UserOperation_email_add_when_none;
|
||||||
CREATE VIEW UserOperation_email_add_when_none AS
|
CREATE VIEW UserOperation_email_add_when_none AS
|
||||||
|
@ -330,7 +209,6 @@ END;
|
||||||
DROP TRIGGER IF EXISTS update_postal_address_preferred_override;
|
DROP TRIGGER IF EXISTS update_postal_address_preferred_override;
|
||||||
DROP TRIGGER IF EXISTS update_postal_address_is_invalid;
|
DROP TRIGGER IF EXISTS update_postal_address_is_invalid;
|
||||||
DROP TRIGGER IF EXISTS update_formatted_postal_address;
|
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;
|
DROP VIEW IF EXISTS UserOperation_postal_address_change;
|
||||||
CREATE VIEW UserOperation_postal_address_change AS
|
CREATE VIEW UserOperation_postal_address_change AS
|
||||||
|
@ -363,16 +241,15 @@ INSERT INTO postal_address(first_name, middle_name, last_name, organization, add
|
||||||
VALUES(NEW.donor_id, (SELECT last_insert_rowid()), 21, date("now"));
|
VALUES(NEW.donor_id, (SELECT last_insert_rowid()), 21, date("now"));
|
||||||
-- VALUES(OLD.donor_id, (SELECT new_postal_address_id FROM wt) );
|
-- VALUES(OLD.donor_id, (SELECT new_postal_address_id FROM wt) );
|
||||||
|
|
||||||
--- FIXME: Below doesn't work in sqlitebrowser, still don't know why
|
SELECT CASE
|
||||||
-- SELECT CASE
|
WHEN ( (SELECT address_1 FROM donor_postal_address_mapping dp, postal_address pa
|
||||||
-- WHEN ( (SELECT address_1 FROM donor_postal_address_mapping dp, postal_address pa
|
WHERE dp.donor_id = NEW.donor_id
|
||||||
-- WHERE dp.donor_id = NEW.donor_id
|
AND pa.id = (SELECT last_insert_rowid() )
|
||||||
-- AND pa.id = (SELECT last_insert_rowid() )
|
AND dp.postal_address_id = (SELECT last_insert_rowid() )
|
||||||
-- AND dp.postal_address_id = (SELECT last_insert_rowid() )
|
AND pa.address_1 = NEW.addr1
|
||||||
-- AND pa.address_1 = NEW.addr1
|
!= NEW.addr1 ) )
|
||||||
-- != NEW.addr1 ) )
|
THEN RAISE(FAIL, "Error encountered while adding new postal address; please verify your changes worked!")
|
||||||
-- THEN RAISE(FAIL, "Error encountered while adding new postal address; please verify your changes worked!")
|
END;
|
||||||
-- END;
|
|
||||||
|
|
||||||
END;
|
END;
|
||||||
|
|
||||||
|
@ -414,21 +291,12 @@ 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
|
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
|
FROM donor, request_configuration, request, request_type
|
||||||
WHERE request.id not in (select request_id from fulfillment) AND
|
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_type.id = request.request_type_id AND
|
||||||
request.donor_id = donor.id AND
|
request.donor_id = donor.id AND
|
||||||
request_configuration.id = request.request_configuration_id
|
request_configuration.id = request.request_configuration_id
|
||||||
ORDER BY donor.ledger_entity_id, request.date_requested;
|
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;
|
DROP TRIGGER IF EXISTS fix_tshirt_size_request_updater;
|
||||||
CREATE TRIGGER fix_tshirt_size_request_updater
|
CREATE TRIGGER fix_tshirt_size_request_updater
|
||||||
INSTEAD OF UPDATE OF size_requested on UserOperation_fix_tshirt_size_request
|
INSTEAD OF UPDATE OF size_requested on UserOperation_fix_tshirt_size_request
|
||||||
|
|
Loading…
Reference in a new issue