31961b997c
I had made various changes the last time we shipped t-shirts, but had never committed them. These are those changes.
270 lines
11 KiB
Perl
270 lines
11 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use autodie qw(:all);
|
|
|
|
use Data::Dumper;
|
|
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*$/);
|
|
|
|
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 $val = $row->{reference1};
|
|
die( "reference1 \"$row->{reference1}\" doesn't have an ID number on end, for shipment: " . Data::Dumper->Dump([$row]))
|
|
unless $val =~ /^\s*(\S+)_(\d+)\s*$/;
|
|
my($id, $shirt) = (int $2, $1);
|
|
$info{$id}{shirts} = {} unless defined $info{$id}{shirts};
|
|
|
|
my($size, $type) = split(/_+/, $shirt);
|
|
if ($type =~ /2018/) {
|
|
$type = 't-shirt-fy2018design-0';
|
|
} elsif ($type =~ /vint/i) {
|
|
$type = 't-shirt-vintage-0';
|
|
} elsif ($type =~ /2021/i) {
|
|
$type = 't-shirt-fy2021design-0';
|
|
} elsif ($type =~ /2022/i) {
|
|
$type = 't-shirt-cy2022design-0';
|
|
} else {
|
|
die "$type is not a known t-shirt type";
|
|
}
|
|
$info{$id}{shirts}{$type}{size} = $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 {
|
|
$service .= " was delivered on $row->{'date delivered'}";
|
|
$delivered = 1 if $row->{'status'} and $row->{'status'} =~ /eliver/i and not $row->{'status'} =~ /undeliv/i;
|
|
}
|
|
} else {
|
|
$service .= " was shipped";
|
|
$thisHow .= " shipped";
|
|
if (defined $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) {
|
|
my @requestTypes = $sp->getRequestType();
|
|
my %need;
|
|
foreach my $requestType (@requestTypes) {
|
|
my $request = $sp->getRequest({ donorId => $id, requestType => $requestType,
|
|
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
|
|
if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
|
|
$need{$request->{requestType}} = $request->{requestConfiguration} if $request->{requestType} =~ /^\s*t-shirt/;
|
|
}
|
|
}
|
|
foreach my $type (keys %{$info{$id}{shirts}}) {
|
|
my $size = $info{$id}{shirts}{$type}{size};
|
|
foreach my $key (keys %need) {
|
|
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
|
|
if ($need{$key} eq $size and $type eq $key) {
|
|
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
|
|
delete $need{$key};
|
|
delete $info{$id}{shirts}{$type};
|
|
}
|
|
}
|
|
}
|
|
foreach my $type (keys %{$info{$id}{shirts}}) {
|
|
my $size = $info{$id}{shirts}{$type}{size};
|
|
foreach my $key (keys %need) {
|
|
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
|
|
if ($need{$key} eq $size and $key =~ /^t-shirt-(extra-)?[0123456789]/) {
|
|
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}});
|
|
delete $need{$key};
|
|
delete $info{$id}{shirts}{$type};
|
|
}
|
|
}
|
|
}
|
|
foreach my $type (keys %{$info{$id}{shirts}}) {
|
|
print "WARNING: For $id, shirt of $type in size $info{$id}{shirts}{$type}{size} did not fulfill a request\n";
|
|
}
|
|
}
|
|
###############################################################################
|
|
#
|
|
# Local variables:
|
|
# compile-command: "perl -c send-t-shirts.plx"
|
|
# End:
|
|
|