supporters/scripts/send-t-shirts.plx

#!/usr/bin/perl

use strict;
use warnings;

use autodie qw(:all);

use Getopt::Long;
use DBI;
use Encode qw(encode decode);
use File::Spec::Functions;
use Time::HiRes qw(usleep nanosleep);

use Text::CSV;  # libtext-csv-perl in Debian
use Supporters;

use strict;
use warnings;

use autodie qw(open close chdir);
use DBI;
use Encode qw(encode decode);

use LaTeX::Encode;

use Supporters;
use utf8;
use IPC::Shareable;
use Email::MIME::RFC2047::Encoder;

my $FROM_ADDRESS = 'info@sfconservancy.org';

require 'bean-query-daemon-lib.pl';
my $encoder = Email::MIME::RFC2047::Encoder->new();

binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";

my($VERBOSE, $stampsComCsvFile, $WHO, $EMAIL_TEMPLATE_FILE, $SUPPORTERS_SQLITE_DB_FILE) =
  (0,        undef,             undef,undef,                catfile($ENV{CONSERVANCY_REPOSITORY},
                                                                          'Financial', 'Ledger', 'supporters.db'));
GetOptions("verbose=i" => \$VERBOSE, "supporterDB=s" => \$SUPPORTERS_SQLITE_DB_FILE,
           'who=s' => \$WHO, 'emailTemplateFile=s' => \$EMAIL_TEMPLATE_FILE,
           'stampsComCsvFile=s' => \$stampsComCsvFile);
sub UsageAndExit($) {
  print STDERR "usage: $0 --stampsComCsvFile=<PATH_TO_FILE> [ --supportersDB=PATH_TO_SUPPORTERS_SQLITE_DB_FILE --verbose=N ]\n";
  print STDERR "\n  $_[0]\n";
  exit 2;
}
UsageAndExit("Cannot read supporters db file: $SUPPORTERS_SQLITE_DB_FILE") unless defined $SUPPORTERS_SQLITE_DB_FILE
  and -r $SUPPORTERS_SQLITE_DB_FILE;
UsageAndExit("Cannot read email template: $EMAIL_TEMPLATE_FILE") unless defined $EMAIL_TEMPLATE_FILE
  and -r $EMAIL_TEMPLATE_FILE;
UsageAndExit("--who is required") unless defined $WHO;
UsageAndExit("Cannot read stampsComCsvFile: $stampsComCsvFile: $!") unless defined $stampsComCsvFile
  and -r $stampsComCsvFile and -f $stampsComCsvFile;

$VERBOSE = 0 if not defined $VERBOSE;

my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
                               { RaiseError => 1, sqlite_unicode => 1 })
  or die $DBI::errstr;

# my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
# SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
#     WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
#       AND ANY_META("program") ~ "Conservancy:Supporters:" AND NOT ANY_META("entity") ~ "^\\s*\$"
# SUPPORTESR_DB_READ
#                                         , 'text');
# open(my $fh, "<", $fileName);

# my $sp = new Supporters($dbh, $fh, { monthly =>               '^Conservancy:Supporters:Monthly',
#                                      annual => '^Conservancy:Supporters:(?:Annual|Match Pledge)' } );
 my $sp = new Supporters($dbh, [ '/bin/false' ]);

my @emailLines;
open(my $emailFH, "<", $EMAIL_TEMPLATE_FILE);
binmode $emailFH, ":utf8";
@emailLines = <$emailFH>;
close $emailFH;

open my $csvFH, "<:encoding(utf8)", $stampsComCsvFile;

my $csv = Text::CSV->new({ quote_char => '"', binary => 1, allow_whitespace => 1, quote_space=> 0,
                           allow_loose_quotes => 1 });
$csv->header($csvFH, { detect_bom => 1, munge_column_names => "lc" });

my %info;
while (my $row = $csv->getline_hr($csvFH)) {
  $row->{'class service'} =~ s/\s*\(\s*R\s*\)\s*$//
    if (defined $row->{'class service'} and $row->{'class service'} !~ /^\s*$/);
  $row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
    if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/);

  die "no reference1"  if (not defined $row->{reference1} );
  my(@vals) = split(',', $row->{reference1});
  my $id = shift @vals;
  $info{$id} = $row;

  $info{$id}{shirts} = {}; $info{$id}{extras} = [];
  foreach my $item (@vals) {
    if ($item =~ /\s*\++\s*(\S.*)$/) {
      push(@{$info{$id}{extras}}, $1);
      next;
    }
    my($size, $type) = split(/_+/, $item);
    if ($type =~ /2018/) {
      $type = 't-shirt-fy2018design-0';
    } elsif ($type =~ /vint/i) {
      $type = 'vintage';
    } else {
      die "$type is not a known t-shirt type";
    }
    $info{$id}{shirts}{$type} = $size;
  }
}

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) {
    my $request = $sp->getRequest({ donorId => $id, requestType => $type,
                                 ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
    if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
      $need{$type} = $request->{requestConfiguration} if $type =~ /^\s*t-shirt/;

    }
  }
  my $cur = 't-shirt-fy2018design-0';
  if (defined $need{$cur} and defined $info{$id}{shirts}{$cur}) {
    die "$id: 2018design: $need{$cur} does not match defined $info{$id}{shirts}{$cur}"
      unless  (($need{$cur} eq $info{$id}{shirts}{$cur}) or
      ($need{$cur} eq 'FittedLadies2XL' and $info{$id}{shirts}{$cur} eq 'Ladies2XL'));
    my $size = $info{$id}{shirts}{$cur};
    $sp->fulfillRequest({ donorId => $id, requestType => $cur, who => $WHO, how => $thisHow});
    $sentData .= "A $size t-shirt in the 2018 design.  ";
    delete $need{$cur};
    delete $info{$id}{shirts}{$cur};
  }
  # vintage type can fulfill other types
  foreach my $shirtType (keys %{$info{$id}{shirts}}) {
    my $size = $info{$id}{shirts}{$shirtType};
    foreach my $key (keys %need) {
      $need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
      if ($need{$key} eq $size)  {
        $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $thisHow});
        $sentData .= "A $size t-shirt in the vintage design.  ";
        delete $need{$key};
        delete $info{$id}{shirts}{$shirtType};
      }
    }
  }
  foreach my $shirtType (keys %{$info{$id}{shirts}}) {
    my $size = $info{$id}{shirts}{$shirtType};
    $sentData .= "A $size t-shirt in the $shirtType design that we included just becuase we thought you would like it.  ";
  }
  foreach my $extra (sort { $a cmp $b}  @{$info{$id}{extras}}) {
    if ($extra =~ /PIN/) {
      $sentData .= "  A pin from our our CopyleftConf 2019!  ";
    } else {
      die "Supporter $id: unkown extra: $extra";
    }
  }
  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;

    print $sendmailFH $thisLine;
  }
  close $sendmailFH;
  usleep(70000);
}
###############################################################################
#
# Local variables:
# compile-command: "perl -c send-t-shirts.plx"
# End: