confess() rather than die() in these locations.

I had made these various additions previously and not committed them.

Supporters/lib/Supporters.pm

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

scripts/calculate-renewal-rate.plx

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

scripts/send-supporter-emails-by-category.plx

@@ -1,7 +1,5 @@
 #!/usr/bin/perl
 
-#!/usr/bin/perl
-
 use strict;
 use warnings;
 use Time::HiRes qw(usleep nanosleep);
@@ -10,6 +8,8 @@ use File::Spec::Functions;
 use autodie qw(:all);
 use DBI;
 
+use Data::Dumper;
+
 use Date::Manip::DM5;
 use Supporters;
 use Encode qw(encode decode);
@@ -19,10 +19,39 @@ use IPC::Shareable;
 
 require 'bean-query-daemon-lib.pl';
 
-my $TOTAL_GROUPS = 2;
+my $TOTAL_GROUPS = 1;
 
 binmode STDOUT, ":utf8";
 
+######################################################################
+sub GetMostInformalName ($$) {
+  my($sp, $id) = @_;
+  my($pa) = $sp->getBestPostalAddress($id);
+  return $pa->{first_name} if (defined $pa and defined $pa->{first_name} and $pa->{first_name} !~ /^\s*$/);
+  my $displayName = $sp->getDisplayName($id);
+  return $displayName;
+}
+######################################################################
+my %SEEN_SERVERS;
+sub EmailControlledByGoogle ($) {
+  my($email) = @_;
+  my $isGoogle = 0;
+  die "$email that is unparasable" unless ($email =~ /^\s*[^@]+@(\S+)\s*$/);
+  my $domain = $1;
+  if (not defined $SEEN_SERVERS{$domain}) {
+    my $isFound = 0;
+    open(my $fh , "-|", '/usr/bin/host', '-t', 'mx', $domain);
+    while (my $line = <$fh>) {
+      if ($line =~ /(gmail|google|googlemail)/i) {
+        $isFound = 1;
+      }
+    }
+    $SEEN_SERVERS{$domain} = $isFound;
+  }
+  return ($SEEN_SERVERS{$domain});
+}
+######################################################################
+
 my $encoder = Email::MIME::RFC2047::Encoder->new();
 
 my $TODAY = UnixDate(ParseDate("today"), '%Y-%m-%d');
@@ -37,74 +66,77 @@ my $NINETEEN_MONTHS_AGO = UnixDate(ParseDate("19 months ago"), '%Y-%m-%d');
 my $THREE_TWENTY_DAYS_AGO = UnixDate(ParseDate("320 days ago"), '%Y-%m-%d');
 my $THREE_MONTHS_AGO = UnixDate(ParseDate("3 months ago"), '%Y-%m-%d');
 my $FY_2019_FUNDRAISER_START = UnixDate(ParseDate("2019-11-26 08:00"), '%Y-%m-%d');
+my $VIZIO_ANNOUNCE_DATE = UnixDate(ParseDate("2021-10-19 00:01"), '%Y-%m-%d');
+my $MARCH_1_2020 = UnixDate(ParseDate("2020-03-01 08:00"), '%Y-%m-%d');
+my $MARCH_1_2023 = UnixDate(ParseDate("2023-03-01 08:00"), '%Y-%m-%d');
+my $JAN_15_2022 = UnixDate(ParseDate("2022-01-15 23:59"), '%Y-%m-%d');
+my $JUL_11_2023 = UnixDate(ParseDate("2023-07-11 23:59"), '%Y-%m-%d');
+my $JAN_15_2023 = UnixDate(ParseDate("2023-01-15 23:59"), '%Y-%m-%d');
 my $NOV_19_2018 = UnixDate(ParseDate("2018-11-19 08:00"), '%Y-%m-%d');
 my $NOV_20_2019 = UnixDate(ParseDate("2018-11-20 08:00"), '%Y-%m-%d');
+my $JAN_31_2019 = UnixDate(ParseDate("2019-01-31 08:00"), '%Y-%m-%d');
 my $NOV_24_2020 = UnixDate(ParseDate("2020-11-24 00:00"), '%Y-%m-%d');
 my $DEC_8_2020 = UnixDate(ParseDate("2020-12-08 00:00"), '%Y-%m-%d');
 my $DEC_22_2020 = UnixDate(ParseDate("2020-12-22 00:00"), '%Y-%m-%d');
 my $NOV_20_2020 = UnixDate(ParseDate("2020-11-20 00:00"), '%Y-%m-%d');
+my $NOV_20_2022 = UnixDate(ParseDate("2022-11-20 00:00"), '%Y-%m-%d');
 my $JAN_20_2019 = UnixDate(ParseDate("2019-01-20 08:00"), '%Y-%m-%d');
 my $JAN_15_2020 = UnixDate(ParseDate("2020-01-15 08:00"), '%Y-%m-%d');
 my $JAN_31_2021 = UnixDate(ParseDate("2021-01-31 20:00"), '%Y-%m-%d');
+my $JAN_31_2022 = UnixDate(ParseDate("2022-01-31 20:00"), '%Y-%m-%d');
 my $JAN_15_2019 = UnixDate(ParseDate("2019-01-15 08:00"), '%Y-%m-%d');
+my $JAN_16_2023 = UnixDate(ParseDate("2023-01-16 08:00"), '%Y-%m-%d');
+my $JAN_1_2024 = UnixDate(ParseDate("2024-01-01 08:00"), '%Y-%m-%d');
 my $JAN_1_2020 = UnixDate(ParseDate("2020-01-01 08:00"), '%Y-%m-%d');
 my $JAN_1_2021 = UnixDate(ParseDate("2021-01-01 08:00"), '%Y-%m-%d');
 my $JAN_1_2022 = UnixDate(ParseDate("2022-01-01 08:00"), '%Y-%m-%d');
+my $JAN_1_2023 = UnixDate(ParseDate("2023-01-01 00:00"), '%Y-%m-%d');
 my $JUN_1_2017 = UnixDate(ParseDate("2017-06-01 08:00"), '%Y-%m-%d');
+my $JAN_31_2017 = UnixDate(ParseDate("2017-01-31 08:00"), '%Y-%m-%d');
 my $START_OF_CY_2020_FUNDRAISER = UnixDate(ParseDate("2020-11-24 00:00"), '%Y-%m-%d');
 my $MAR_1_2020 = UnixDate(ParseDate("2020-03-01 08:00"), '%Y-%m-%d');
 my $MAR_1_2019 = UnixDate(ParseDate("2019-03-01 08:00"), '%Y-%m-%d');
+my $MAR_1_2016 = UnixDate(ParseDate("2016-03-01 08:00"), '%Y-%m-%d');
 my $OCT_1_2020 = UnixDate(ParseDate("2020-10-01 08:00"), '%Y-%m-%d');
 my $END_LAST_YEAR = '2020-12-31';
 my $OCT_19_2021 = UnixDate(ParseDate("2021-10-19 08:00"), '%Y-%m-%d');
 my $NOV_2_2021 = UnixDate(ParseDate("2021-11-02 08:00"), '%Y-%m-%d');
 my $NOV_21_2021 = UnixDate(ParseDate("2021-11-21 08:00"), '%Y-%m-%d');
+my $NOV_22_2022 = UnixDate(ParseDate("2022-11-22 08:00"), '%Y-%m-%d');
+my $OCT_1_2023 = UnixDate(ParseDate("2023-10-01 08:00"), '%Y-%m-%d');
+
 
 if (@ARGV < 6) {
   print STDERR "usage: $0 <SUPPORTERS_SQLITE_DB_FILE> <FROM_ADDRESS> <EMAIL_TEMPLATE_SUFFIX> <BAD_ADDRESS_LIST_FILE> <MONTHLY_SEARCH_REGEX> <ANNUAL_SEARCH_REGEX>  <GLUE> <VERBOSE>\n";
   exit 1;
 }
 
-my($SUPPORTERS_SQLITE_DB_FILE, $FROM_ADDDRESS, $EMAIL_TEMPLATE_SUFFIX, $BAD_ADDRESS_LIST_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $VERBOSE) = @ARGV;
+my($SUPPORTERS_SQLITE_DB_FILE, $FROM_ADDDRESS, $EMAIL_TEMPLATE_SUFFIX, $BAD_ADDRESS_LIST_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $GLUE, $VERBOSE) = @ARGV;
 $VERBOSE = 0 if not defined $VERBOSE;
 
-BeancountQueryInitialize("BeAn");
-my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
-                               { RaiseError => 1, sqlite_unicode => 1 })
-  or die $DBI::errstr;
-
-my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
-SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
-    WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
-      AND ANY_META("program") ~ "Conservancy:Supporters:" AND NOT ANY_META("entity") ~ "^\\s*\$"
-SUPPORTESR_DB_READ
-                                        , 'text');
-open(my $fh, "<", $fileName);
-
-my $sp = new Supporters($dbh, $fh, { monthly => $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX});
-
 my %groupLines;
 foreach my $group (1 .. $TOTAL_GROUPS) {
   $groupLines{$group} = [];
-  open(my $emailFH, "<", "group-${group}" . $EMAIL_TEMPLATE_SUFFIX);
+  my %ff = ($group => "group-${group}$EMAIL_TEMPLATE_SUFFIX",
-  binmode $emailFH, ":utf8";
+            "${group}-no-html", "no-html-group-${group}$EMAIL_TEMPLATE_SUFFIX");
-
+  foreach my $subgroup (sort keys %ff) {
-  @{$groupLines{$group}} = <$emailFH>;
+    open(my $emailFH, "<", $ff{$subgroup});
-  close $emailFH;
+    binmode $emailFH, ":utf8";
+    @{$groupLines{$subgroup}} = <$emailFH>;
+    close $emailFH;
+  }
 }
 foreach my $group (($TOTAL_GROUPS+1) ... 999) {
   my $file = "group-${group}" . $EMAIL_TEMPLATE_SUFFIX;
   die "$file exists but you didn't include it in any groups" if -f $file;
 }
-
-
 my %skip = ();
 sub update_skips {
   my $skips = shift;
   my $source_filename = shift;
-  open(my $skipFH, '<', $source_filename) or
+  open(my $skipFH, '<', $source_filename);
-    die "couldn't open skip file $source_filename: $!";
   while (my $email = <$skipFH>) {
+    next if $email =~ /^\s*#/;
     chomp $email;
     $skips->{$email} = $source_filename;
   }
@@ -113,13 +145,30 @@ sub update_skips {
 if (defined $BAD_ADDRESS_LIST_FILE) {
   update_skips(\%skip, $BAD_ADDRESS_LIST_FILE);
 }
+$GLUE = "BeAn" unless defined $GLUE and $GLUE !~ /^\s*$/;
+
+BeancountQueryInitialize($GLUE);
+my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
+                               { RaiseError => 1, sqlite_unicode => 1 })
+  or die $DBI::errstr;
+
+my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
+SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
+    WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
+      AND ANY_META("program") ~ "Conservancy:(Supporters?|Sustainers?|Match Pledge):" AND NOT ANY_META("entity") ~ "^\\s*\$"
+SUPPORTESR_DB_READ
+                                        , 'text');
+open(my $fh, "<", $fileName);
+
+my $sp = new Supporters($dbh, $fh, { monthly => $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX});
+
 
 my %groupCounts;
 for my $ii (0 .. $TOTAL_GROUPS) { $groupCounts{$ii} = 0; }
 
 my(@supporterIds) = $sp->findDonor({});
-open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/2021-12_Postcard',
+open(my $idsInUSAFH, "<", catfile($ENV{CONSERVANCY_REPOSITORY}, 'Fundraising/Supporters/',
-                                 'donor-ids-in-usa.txt'));
+                                 'donor-ids-we-expect-are-probably-usa.txt'));
 my %idsKnownToBeInUSA;
 while (my $idInUSA = <$idsInUSAFH>) {
   chomp $idInUSA;
@@ -127,60 +176,52 @@ while (my $idInUSA = <$idsInUSAFH>) {
 }
 close $idsInUSAFH;
 
+my $totalSupportersSent = 0;
+
 MAIN_SUPPORTER_LOOP:
 foreach my $id (sort { $a <=> $b } @supporterIds) {
   next unless $sp->isSupporter($id);
   my $donorType = lc($sp->getType($id));
   my $expiresOn = $sp->supporterExpirationDate($id);
   my $isLapsed = ( (not defined $expiresOn) or $expiresOn lt $TODAY);
-
   my $amount = $sp->donorTotalGaveInPeriod(donorId => $id);
   my $lastGaveDate = $sp->donorLastGave($id);
   my $firstGaveDate = $sp->donorFirstGave($id);
   my $nineMonthsSinceFirstGave = UnixDate(DateCalc(ParseDate($firstGaveDate), "+ 9 months"), '%Y-%m-%d');
-
   # Compute "likely USA"
   my $likelyUSA = 0;
-  my $postalAddress = $sp->getPreferredPostalAddress($id);
+  my(%postalAddresses) = $sp->getPostalAddresses($id);
-  my(@postalAddresses) = $sp->getPostalAddresses($id);
   $likelyUSA = 1 if defined $idsKnownToBeInUSA{$id};
   if (not $likelyUSA) {
-    foreach $postalAddress (@postalAddresses) {
+    foreach my $pid (sort {$a <=> $b} keys %postalAddresses) {
-      $likelyUSA = 1
+      my $postalAddress = $postalAddresses{$pid};
-        if (defined $postalAddress and
+      if (defined $postalAddress and (not defined $postalAddress->{country} or $postalAddress->{country} =~ /^\s*$/ or
-          $postalAddress =~ /United\s*States|USA|,\s*\S+\s+\d{5,5}(\s+|$)|,\s*\S+\s+\d{5,5}\-\d{4,4}(\s+|$)/mi
+                                      $postalAddress->{country} =~ /^\s*(United\s*States|U[\s\.]*S[\s\.]*A[\s\.]*|U\s*S)\s*$/mi)) {
-          and (not $postalAddress =~ /Saudi\s*Arabia|France|Sweden|Uruguay|Bulgaria|Indonesia|Switzerland|Spain|Brasil|Brazil|Estonia|Germany|Bosnia|Herzegovina|Italy|Czech|Finland|Korea|Ireland/im));
+        $likelyUSA = 1;
+      }
     }
   }
   my $group = 0;
   my $specialContact = "";
-  if (not $sp->emailOk($id)) {
+  my $annualRenewalText = " ";
-    my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'});
+  # if (not $sp->emailOk($id)) {
-    if (defined $req and defined $req->{requestConfiguration} and
+  #   print "NOT-SENT: SUPPORTER $id: supporter is unsubscribed from mass emails.\n";
-        $req->{requestConfiguration} eq 'only-one-annual-renewal-notice') {
+  #   $groupCounts{0}++;
-      $specialContact = 'only-one-annual-renewal-notice: ';
+  #   next;
-    } 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
   my %emails;
-  my $email = $sp->getPreferredEmailAddress($id);
+  my $emailP = $sp->getPreferredEmailAddress($id);
-  if (defined $email) {
+  if (defined $emailP) {
-    $emails{$email} = {};
+    $emails{$emailP} = {};
   } else {
     %emails = $sp->getEmailAddresses($id);
   }
   my @badEmails;
-  foreach $email (keys %emails) {
+  my $atLeastOneSkipHere = 0;
+  foreach my $email (keys %emails) {
     if (defined $skip{$email}) {
+      $atLeastOneSkipHere = 1;
       delete $emails{$email};
       push(@badEmails, $email);
     }
@@ -188,112 +229,111 @@ foreach my $id (sort { $a <=> $b } @supporterIds) {
   if (scalar(keys %emails) <= 0) {
     print "NOT-SENT: SUPPORTER $id: these email address(es) is/were bad: ",
       join(",", @badEmails), "\n";
-      $groupCounts{0}++;
+    $group = 0; $groupCounts{$group}++;
     next;
   }
   my(@emails) = keys(%emails);
-
+  if (not defined $lastGaveDate) {
-  if ($lastGaveDate ge $NOV_20_2020 and $lastGaveDate le $JAN_31_2021) {
+    print "NOT-SENT: SUPPORTER $id: WARNING: very strange, this $donorType donor has never given at all, so not emailing because of that\n";
-      $group = 2;
+    $group = 0;
-  } elsif ($lastGaveDate ge $NOV_21_2021) {
+    $groupCounts{$group}++;
+    next;
+  } elsif (not defined $firstGaveDate) {
+    print "NOT-SENT: SUPPORTER $id: WARNING: very strange, this $donorType donor has never given at all, so not emailing because of that\n";
+    $group = 0;
+    $groupCounts{$group}++;
+    next;
+  }
+  if (not $sp->emailOk($id)) {
+    my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'});
+    $group = 0; $groupCounts{$group}++;
+    if (defined $req and defined $req->{requestConfiguration} and
+        $req->{requestConfiguration} eq 'only-one-annual-renewal-notice')  {
+      print "NOT-SENT: SUPPORTER $id: has requested only one annual-renewal notice, and this mailing is not that.\n";
+      next;
+    } else {
+      print "NOT-SENT: SUPPORTER $id: has requested no email contact ($req->{requestConfiguration}) so no email will be sent.\n";
+      next;
+    }
+    print "NOT-SENT: SUPPORTER $id: WARNING: WEIRD ERROR THAT WE COULD NOT FIGURE OUT WHY THIS ONE WANTED NO EMAIL?  BUT WE DID NOT SEND\n";
+    next;
+  }
+  if ($lastGaveDate ge $NOV_22_2022 and $lastGaveDate le $JAN_16_2023) {
     $group = 1;
-  } elsif ($lastGaveDate lt $NOV_21_2021 or ($lastGaveDate gt $JAN_31_2021 and $lastGaveDate lt $NOV_20_2020)) {
+  } elsif ($lastGaveDate ge $NOV_2_2021 and $lastGaveDate le $JAN_15_2022) {
-    $groupCounts{-1} = 0 unless defined $groupCounts{-1};
+    $group = 1;
-    $groupCounts{-1}++;
+  } elsif ($lastGaveDate le $NOV_22_2022) {
-  # if (not $sp->emailOk($id)) {
+    $group = 0; # Gave really really recently, don't send
-  #   my $req = $sp->getRequest({donorId => $id, requestType => 'contact-setting'});
+    $groupCounts{$group}++;
-  #   if (defined $req and defined $req->{requestConfiguration} and
+    print "NOT-SENT: SUPPORTER $id: supporter gave too long ago, skipping\n";
-  #       $req->{requestConfiguration} eq 'only-one-annual-renewal-notice') {
+    next;
-  #     $specialContact = 'only-one-annual-renewal-notice: ';
+  } elsif ($lastGaveDate ge $JAN_16_2023) {
-  #   } else {
+    $group = 0; # Gave really really recently, don't send
-  #     print "NOT-SENT: SUPPORTER $id: has requested no email contact\n";
+    $groupCounts{$group}++;
-  #     $groupCounts{$group}++;
+    print "NOT-SENT: SUPPORTER $id: supporter gave to recently, skipping.\n";
-  #     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\"";
   }
   if ($group <= 0) {
-    print "NOT-SENT: SUPPORTER $id: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate\n";
+    print "NOT-SENT: SUPPORTER $id: WARNING: Fit in no specified group: Type: $donorType, Last Gave: $lastGaveDate, $firstGaveDate, $likelyUSA, @emails\n";
     $groupCounts{0}++;
     next;
   }
-  # Staff testing code 
-#   next unless ($group == 6); # or $id == 34);  # $id == 26
-   # $group = 3 if $id == 34;
-
-  my $fullEmailLine = "";
-  my $emailTo = join(' ', @emails);
-  my $displayName = $sp->getDisplayName($id);
-  foreach my $email (@emails) {
-    $fullEmailLine .= ", " if ($fullEmailLine ne "");
-    my $line = "";
-    if (defined $displayName) {
-      $line .= $encoder->encode_phrase($displayName) . " ";
-    }
-    $line .= "<$email>";
-    $fullEmailLine .= $line;
-  }
   $expiresOn = "" if not defined $expiresOn;
   my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
   $rtTicket = "" if not defined $rtTicket;
   $rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
-  print "SENT: SUPPORTER $id: Group $group: $specialContact", join(",", sort {$a cmp $b } @emails), "\n";
+  foreach my $emailTo (@emails) {
+    my $displayName = $sp->getDisplayName($id);
+    my $fullEmailLine = "";
+    if (defined $displayName) { $fullEmailLine .= $encoder->encode_phrase($displayName) . " "; }
+    $fullEmailLine .= "<$emailTo>";
+    my $thisEmailGroup = $group;
+    $thisEmailGroup = "${group}-no-html" if (EmailControlledByGoogle($emailTo));
 
-  open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDDRESS, '-oi', '-oem', '--',
+    open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDDRESS, '-oi', '-oem', '--', $emailTo);
-       @emails);
+    binmode $sendmailFH, ":utf8";
-  binmode $sendmailFH, ":utf8";
+    print $sendmailFH "To: $fullEmailLine\n";
-  print $sendmailFH "To: $fullEmailLine\n";
+    $displayName = GetMostInformalName($sp, $id);
-  foreach my $line (@{$groupLines{$group}}) {
+    foreach my $line (@{$groupLines{$thisEmailGroup}}) {
-    die "no displayname for this item" if not defined $displayName or $displayName =~ /^\s*$/;
+      if (not defined $displayName or $displayName =~ /^\s*$/ ) {
-    my $thisLine = $line;   # Note: This is needed, apparently $line is by reference?
+        BeancountQueryComplete();
-    $thisLine =~ s/FIXME_DISPLAYNAME/$displayName/g;
+        die "no displayname for this item";
-    $thisLine =~ s/FIXME_SUPPORTER_ID/$id/g;
+      }
-    $thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
+      my $thisLine = $line;   # Note: This is needed, apparently $line is by reference?
-    print $sendmailFH $thisLine;
+      $thisLine =~ s/FIXME_DISPLAYNAME/$displayName/g;
+      $thisLine =~ s/FIXME_SUPPORTER_ID/$id/g;
+      $thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
+      $thisLine =~ s/FIXME_ANNUAL_ONLY/$annualRenewalText/g;
+      print $sendmailFH $thisLine;
+    }
+    close $sendmailFH;
+    usleep(41000);
+    $groupCounts{$thisEmailGroup}++;
   }
-  close $sendmailFH;
+  $totalSupportersSent++;
-  usleep(70000);
+  print "SENT: SUPPORTER $id: Group $group: $specialContact", " Count: ", scalar(@emails), ": ";
-  $groupCounts{$group}++;
+  my $moreThanOneEmail = 0;
+  foreach my $email (sort {$a cmp $b } @emails) {
+    print ", " if $moreThanOneEmail; $moreThanOneEmail++;
+    print $email;
+    if (EmailControlledByGoogle($email)) { print " (NO-HTML VERSION)"; }
+  }
+  print "\n";
 }
+BeancountQueryComplete();
 print "\n\n";
 my $totalSent = 0;
 foreach my $group (sort keys %groupCounts) {
   print "TOTAL IN GROUP $group: $groupCounts{$group}\n";
+  no warnings 'numeric';
   $totalSent += $groupCounts{$group} if $group > 0;
 }
-print "\n\nTOTAL EMAILS SENT: $totalSent\n";
+print "\n\nTOTAL EMAILS SENT:     $totalSent\n";
-BeancountQueryComplete();
+print     "TOTAL SUPPORTERS SENT: $totalSupportersSent\n";
+print "\nNOTE: For Sustainers with more than one valid email address on file, they are counted for each email sent.  That's why two totals above\n";
 
 ###############################################################################
 #

scripts/send-t-shirts.plx

@@ -5,6 +5,7 @@ use warnings;
 
 use autodie qw(:all);
 
+use Data::Dumper;
 use Getopt::Long;
 use DBI;
 use Encode qw(encode decode);
@@ -92,159 +93,174 @@ while (my $row = $csv->getline_hr($csvFH)) {
   $row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
     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} );
-  my(@vals) = split(',', $row->{reference1});
+  my $val = $row->{reference1};
-  my $id = shift @vals;
+  die( "reference1 \"$row->{reference1}\" doesn't have an ID number on end, for shipment: " . Data::Dumper->Dump([$row]))
-  $info{$id} = $row;
+    unless $val =~ /^\s*(\S+)_(\d+)\s*$/;
+  my($id, $shirt) = (int $2, $1);
+  $info{$id}{shirts} = {} unless defined $info{$id}{shirts};
 
-  $info{$id}{shirts} = {}; $info{$id}{extras} = [];
+  my($size, $type) = split(/_+/, $shirt);
-  foreach my $item (@vals) {
+  if ($type =~ /2018/) {
-    if ($item =~ /\s*\++\s*(\S.*)$/) {
+    $type = 't-shirt-fy2018design-0';
-      push(@{$info{$id}{extras}}, $1);
+  } elsif ($type =~ /vint/i) {
-      next;
+    $type = 't-shirt-vintage-0';
-    }
+  } elsif ($type =~ /2021/i) {
-    my($size, $type) = split(/_+/, $item);
+    $type = 't-shirt-fy2021design-0';
-    if ($type =~ /2018/) {
+  } elsif ($type =~ /2022/i) {
-      $type = 't-shirt-fy2018design-0';
+    $type = 't-shirt-cy2022design-0';
-    } elsif ($type =~ /vint/i) {
+  } else {
-      $type = 'vintage';
+    die "$type is not a known t-shirt type";
+  }
+  $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 {
-      die "$type is not a known t-shirt type";
+      $service .= " was delivered on $row->{'date delivered'}";
+      $delivered = 1 if $row->{'status'} and $row->{'status'} =~ /eliver/i and not $row->{'status'} =~ /undeliv/i;
     }
-    $info{$id}{shirts}{$type} = $size;
+    } else {
+      $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) {
-  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 $sizesSent;
   my %need;
-  foreach my $type (@requestTypes) {
+  foreach my $requestType (@requestTypes) {
-    my $request = $sp->getRequest({ donorId => $id, requestType => $type,
+    my $request = $sp->getRequest({ donorId => $id, requestType => $requestType,
-                                 ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
+                                    ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
     if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
-      $need{$type} = $request->{requestConfiguration} if $type =~ /^\s*t-shirt/;
+      $need{$request->{requestType}} = $request->{requestConfiguration} if $request->{requestType} =~ /^\s*t-shirt/;
-
     }
   }
-  my $cur = 't-shirt-fy2018design-0';
+  foreach my $type (keys %{$info{$id}{shirts}}) {
-  if (defined $need{$cur} and defined $info{$id}{shirts}{$cur}) {
+    my $size = $info{$id}{shirts}{$type}{size};
-    die "$id: 2018design: $need{$cur} does not match defined $info{$id}{shirts}{$cur}"
-      unless  (($need{$cur} eq $info{$id}{shirts}{$cur}) or
-      ($need{$cur} eq 'FittedLadies2XL' and $info{$id}{shirts}{$cur} eq 'Ladies2XL'));
-    my $size = $info{$id}{shirts}{$cur};
-    $sp->fulfillRequest({ donorId => $id, requestType => $cur, who => $WHO, how => $thisHow});
-    $sentData .= "A $size t-shirt in the 2018 design.  ";
-    delete $need{$cur};
-    delete $info{$id}{shirts}{$cur};
-  }
-  # vintage type can fulfill other types
-  foreach my $shirtType (keys %{$info{$id}{shirts}}) {
-    my $size = $info{$id}{shirts}{$shirtType};
     foreach my $key (keys %need) {
       $need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
-      if ($need{$key} eq $size)  {
+      if ($need{$key} eq $size and $type eq $key)  {
-        $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $thisHow});
+        $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
-        $sentData .= "A $size t-shirt in the vintage design.  ";
         delete $need{$key};
-        delete $info{$id}{shirts}{$shirtType};
+        delete $info{$id}{shirts}{$type};
       }
     }
   }
-  foreach my $shirtType (keys %{$info{$id}{shirts}}) {
+  foreach my $type (keys %{$info{$id}{shirts}}) {
-    my $size = $info{$id}{shirts}{$shirtType};
+    my $size = $info{$id}{shirts}{$type}{size};
-    $sentData .= "A $size t-shirt in the $shirtType design that we included just becuase we thought you would like it.  ";
+    foreach my $key (keys %need) {
-  }
+      $need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
-  foreach my $extra (sort { $a cmp $b}  @{$info{$id}{extras}}) {
+      if ($need{$key} eq $size and $key =~ /^t-shirt-(extra-)?[0123456789]/)  {
-    if ($extra =~ /PIN/) {
+        $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
-      $sentData .= "  A pin from our our CopyleftConf 2019!  ";
+        delete $need{$key};
-    } else {
+        delete $info{$id}{shirts}{$type};
-      die "Supporter $id: unkown extra: $extra";
+      }
     }
   }
-  my %emails;
+  foreach my $type (keys %{$info{$id}{shirts}}) {
-  my $email = $sp->getPreferredEmailAddress($id);
+    print "WARNING: For $id, shirt of $type in size $info{$id}{shirts}{$type}{size} did not fulfill a request\n";
-  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);
 }
 ###############################################################################
 #

scripts/t-shirt-label-print.plx

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

sql/supporters-schema.sql

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