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

Various changes from last time t-shirts were shipped.

Browse source 
I had made various changes the last time we shipped t-shirts, but had
never committed them.  These are those changes.
This commit is contained in:
Bradley M. Kuhn 2024-11-03 15:53:08 -08:00
parent 8dafdf9dc4
commit 31961b997c
2 changed files with 392 additions and 208 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -5,6 +5,7 @@ use warnings;
use autodie qw(:all); use autodie qw(:all);
use Data::Dumper;
use Getopt::Long; use Getopt::Long;
use DBI; use DBI;
use Encode qw(encode decode); use Encode qw(encode decode);
@ -92,159 +93,174 @@ while (my $row = $csv->getline_hr($csvFH)) {
$row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/ $row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/); if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/);
if ($row->{status} =~ /refund\s*pending/i and $row->{'refund status'} =~ /pending/i) {
print STDERR "Refund pending for this item: ", Data::Dumper->Dump([$row]);
next;
}
die "no reference1" if (not defined $row->{reference1} ); die "no reference1" if (not defined $row->{reference1} );
my(@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 { } 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) { foreach my $id (sort keys %info) {
print "#" x 75;
print "\n";
print "Supporter $id:\n";
foreach my $type (sort { $a cmp $b} keys %{$info{$id}{shirts}}) { print " Shirt: $type: $info{$id}{shirts}{$type}\n " }
foreach my $extra (sort { $a cmp $b} @{$info{$id}{extras}}) { print " EXTRA: $extra\n " }
my $sentData = "";
my $thisHow = "a package sent with stamp.com";
my $service = "The package";
my $delivered = 0;
if (defined $info{$id}{'date delivered'} and $info{$id}{'date delivered'} !~ /^\s*$/) {
if (defined $info{$id}{'class service'} and $info{$id}{'class service'} =~ /int\'l|international/i) {
$service .= " left the USA sorting facility (bound for your country) on $info{$id}{'date delivered'}";
} else {
$service .= " was delivered on $info{$id}{'date delivered'}";
$delivered = 1 if $info{$id}{'status'} and $info{$id}{'status'} =~ /eliver/i;
}
} else {
$service .= " was shipped";
$thisHow .= " shipped";
if (defined $info{$id}{'ship date'} and $info{$id}{'ship date'} !~ /^\s*$/) {
$service .= " on $info{$id}{'ship date'}";
$thisHow .= " on $info{$id}{'ship date'}";
}
}
$service .= " via $info{$id}{carrier}";
$thisHow .= " with $info{$id}{carrier}";
if (defined $info{$id}{'class service'} and $info{$id}{'class service'} !~ /^\s*$/) {
$service .= "'s $info{$id}{'class service'}";
$thisHow .= "'s $info{$id}{'class service'}";
}
if (defined $info{$id}{'tracking #'} and $info{$id}{'tracking #'} !~ /^\s*$/) {
$service .= " with tracking number of $info{$id}{'tracking #'}";
$thisHow .= " having a tracking number of $info{$id}{'tracking #'}";
}
$service .= ".";
my $deliveryStatus = " The postal service has often been quite slow during the pandemic, so please be patient, but if the packge does not arrive within a few weeks, please contact us by replying to this email.";
$deliveryStatus = "The postal service has confirmed delivery occurred, so please contact us *immediately* by replying to this email if the packge has not been received."
if $delivered;
my @requestTypes = $sp->getRequestType(); my @requestTypes = $sp->getRequestType();
my $sizesSent;
my %need; my %need;
foreach my $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}) { 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) { foreach my $key (keys %need) {
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/); $need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
if ($need{$key} eq $size) { 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 $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);
} }
############################################################################### ###############################################################################
# #

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

@ -5,48 +5,110 @@ use strict;
use warnings; use warnings;
use autodie qw(open close chdir); use autodie qw(open close chdir);
use Getopt::Long;
use DBI; use DBI;
use Encode qw(encode decode); use Encode qw(encode decode);
use Text::CSV; # libtext-csv-perl in Debian use Text::CSV; # libtext-csv-perl in Debian
use YAML::XS qw(LoadFile); use YAML::XS qw(LoadFile);
use File::Spec::Functions qw(rel2abs catfile);
use LaTeX::Encode; use LaTeX::Encode;
use Supporters; use Supporters;
use utf8; use utf8;
use IPC::Shareable; use IPC::Shareable;
sub NotBlank { return (defined($_[0]) and ($_[0] !~ /^\s*$/)); }
my %WEIGHTS =
('2018design' => { Men3XL => 8.5, Men2XL => 7.9, MenXL => 7.1, MenL => 6.4,
MenM => 6.1, FittedLadiesXL => 5.7, FittedLadiesL => 5.6,
FittedLadiesM => 5.4, FittedLadiesS => 4.8,
StandardLadiesXL => 6.4, StandardLadiesL => 5.8, StandardLadiesM => 5.4 },
'2021design' => { Men3XL => 8.6, Men2XL => 8.6, MenXL => 8.4, MenL => 7.7,
MenM => 7, MenS => 5.5, FittedLadies2XL => 5.4, FittedLadiesXL => 5.2,
FittedLadiesL => 5.4, FittedLadiesM => 5.4, StandardLadies2XL => 6.2,
StandardLadiesXL => 6.0, StandardLadiesL => 5.4, StandardLadiesM => 5.4,
StandardLadiesS => 5.3 },
'2022design' => { Men3XL => 8.6, Men2XL => 8.6, MenXL => 8.4, MenL => 7.7,
MenM => 7, MenS => 5.5, FittedLadies2XL => 5.4, FittedLadiesXL => 5.2,
FittedLadiesL => 5.4, FittedLadiesM => 5.4, StandardLadies2XL => 6.2,
StandardLadiesXL => 6.0, StandardLadiesL => 5.4, StandardLadiesM => 5.4,
StandardLadiesS => 5.3 },
'2023design' => { Men3XL => 8.6, Men2XL => 8.6, MenXL => 8.4, MenL => 7.7,
MenM => 7, MenS => 5.5, FittedLadies2XL => 5.4, FittedLadiesXL => 5.2,
FittedLadiesL => 5.4, FittedLadiesM => 5.4, StandardLadies2XL => 6.2,
StandardLadiesXL => 6.0, StandardLadiesL => 5.4, StandardLadiesM => 5.4,
StandardLadiesS => 5.3 },
'vintage' => { MenS => 6.2, MenM => 6.4, MenL => 7.2, MenXL => 8.1, Men2XL => 8.7, Men3XL => 9.5,
StandardLadiesS => 6.2, StandardLadiesM => 7.1, StandardLadiesL => 5.8,
StandardLadiesXL => 6.2, StandardLadies2XL => 6.6, FittedLadiesS => 4.6,
FittedLadiesM => 4.9, FittedLadiesL => 5.3, FittedLadiesXL => 5.7 });
my @headerFields = ('Order ID (required)', 'Order Date', 'Order Value', 'Requested Service', 'Ship To - Name', 'Ship To - Company',
'Ship To - Address 1', 'Ship To - Address 2', 'Ship To - Address 3', 'Ship To - State/Province',
'Ship To - City', 'Ship To - Postal Code', 'Ship To - Country', 'Ship To - Phone', 'Ship To - Email',
'Total Weight in Oz', 'Dimensions - Length', 'Dimensions - Width', 'Dimensions - Height',
'Notes - From Customer', 'Notes - Internal', 'Gift Wrap?', 'Gift Message');
require 'bean-query-daemon-lib.pl'; require 'bean-query-daemon-lib.pl';
binmode STDOUT, ":utf8"; binmode STDOUT, ":utf8";
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(@usaRows, @intRows);
my($sizeCounts);
$sizeCounts = LoadFile $SIZE_COUNT_FILE if (defined $SIZE_COUNT_FILE and -r $SIZE_COUNT_FILE);
my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "", my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
{ RaiseError => 1, sqlite_unicode => 1 }) { RaiseError => 1, sqlite_unicode => 1 })
or die $DBI::errstr; or die $DBI::errstr;
BeancountQueryInitialize($GLUE);
my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ my $fileName = BeancountQuerySubmit(<<SUPPORTESR_DB_READ
SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position)) SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy" WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
@ -63,8 +125,17 @@ my %lines;
my @typeList; my @typeList;
my @oldTypeList; my @oldTypeList;
if ($T_SHIRT_STYLE eq 'ONLY-fy2021design') { if ($T_SHIRT_STYLE eq 'ALL') {
@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 'ONLY-fy2021design') {
@typeList = qw/t-shirt-fy2021design-0/; @typeList = qw/t-shirt-fy2021design-0/;
} elsif ($T_SHIRT_STYLE eq 'cy2023design') {
@typeList = qw/t-shirt-cy2023design-0 t-shirt-cy2022design-0 t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
} elsif ($T_SHIRT_STYLE eq 'cy2022design') {
@typeList = qw/t-shirt-cy2022design-0 t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
} elsif ($T_SHIRT_STYLE eq 'fy2021design') { } elsif ($T_SHIRT_STYLE eq 'fy2021design') {
@typeList = qw/t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/; @typeList = qw/t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/;
@oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/; @oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/;
@ -77,7 +148,7 @@ if ($T_SHIRT_STYLE eq 'ONLY-fy2021design') {
@oldTypeList = qw/t-shirt-0 t-shirt-extra-0/; @oldTypeList = qw/t-shirt-0 t-shirt-extra-0/;
@typeList = qw/t-shirt-1 t-shirt-extra-1/; @typeList = qw/t-shirt-1 t-shirt-extra-1/;
} else { } else {
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; my %requestData;
@ -96,6 +167,19 @@ foreach my $id (@supporterIds) {
$requestData{$id}{oldestShirtDate} = '9999-12-31' unless defined $requestData{$id}{oldestShirtDate}; $requestData{$id}{oldestShirtDate} = '9999-12-31' unless defined $requestData{$id}{oldestShirtDate};
$requestData{$id}{forSortingbySize} = "" unless defined $requestData{$id}{forSortingbySize}; $requestData{$id}{forSortingbySize} = "" unless defined $requestData{$id}{forSortingbySize};
$requestData{$id}{forSortingbyType} = 'ZZZZ' unless defined $requestData{$id}{forSortingbyType};
if ($type =~ /2022/) {
$requestData{$id}{forSortingbyType} = "C-2022" if "C-2022" lt $requestData{$id}{forSortingbyType};
} elsif ($type =~ /2021/) {
$requestData{$id}{forSortingbyType} = "D-2021" if "D-2021" lt $requestData{$id}{forSortingbyType};
} elsif ($type =~ /vintage/) {
$requestData{$id}{forSortingbyType} = "B-vintage" if "B-vintage" lt $requestData{$id}{forSortingbyType};
} elsif ($type =~ /2018/) {
$requestData{$id}{forSortingbyType} = "A-2018" if "A-2018" lt $requestData{$id}{forSortingbyType};
} else {
$requestData{$id}{forSortingbyType} = "E-any" if "E-any" lt $requestData{$id}{forSortingbyType};
}
$requestData{$id}{shirts}{$request->{requestType}} = $request; $requestData{$id}{shirts}{$request->{requestType}} = $request;
$requestData{$id}{forSortingbySize} = $request->{requestConfiguration} $requestData{$id}{forSortingbySize} = $request->{requestConfiguration}
if ($requestData{$id}{forSortingbySize} eq "" and defined $request->{requestConfiguration}); if ($requestData{$id}{forSortingbySize} eq "" and defined $request->{requestConfiguration});
@ -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]}{oldestShirtDate} cmp $requestData{$_[1]}{oldestShirtDate}) or
($requestData{$_[0]}{forSortingbySize} cmp $requestData{$_[1]}{forSortingbySize}) or ($requestData{$_[0]}{forSortingbySize} cmp $requestData{$_[1]}{forSortingbySize}) or
($requestData{$_[1]}{lastGaveDate} cmp $requestData{$_[0]}{lastGaveDate}) or
($requestData{$_[1]}{total} <=> $requestData{$_[0]}{total}) or
($_[0] <=> $_[1])); ($_[0] <=> $_[1]));
} }
my %need; my %need;
my $orderNum = $SERIAL_ORDER_START;
foreach my $id (sort { sortFunction($a, $b); } keys %requestData) { foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
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 $email = $sp->getPreferredEmailAddress($id);
my @emails; my @emails;
if (not defined $email) { if (not defined $email) {
my(%emails) = $sp->getEmailAddresses($id); my(%emails) = $sp->getEmailAddresses($id);
my $bestDate = '0001-01-01'; my $bestDate = '0001-01-01';
foreach my $possibleEmail (keys %emails) { foreach my $possibleEmail (keys %emails) {
# There is a bug in $sp->getEmailAddresses() whereby it's returning a blank row; I don't know why, but that's why this next line is here:
next if ( (not defined $possibleEmail) or ($possibleEmail =~ /^\s*$/));
push(@emails, $possibleEmail); push(@emails, $possibleEmail);
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) { if ($emails{$possibleEmail}{date_encountered} gt $bestDate) {
$email = $possibleEmail; $bestDate = $emails{$possibleEmail}{date_encountered}; $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; 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' }); my $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2018design-0' });
$specificRequest2018 = (defined $request); $specificRequest2018 = (defined $request);
$request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2021design-0' }); $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2021design-0' });
$specificRequest2021 = (defined $request); $specificRequest2021 = (defined $request);
my $bestPostal; $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-cy2022design-0' });
$specificRequest2022 = (defined $request);
my %bestPostal;
my $remainingQualifyingDonations = $requestData{$id}{total}; 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" . my $outputSoFar = "$id:\n" . " oldest request: $requestData{$id}{oldestShirtDate}\n" .
" lastGave: $requestData{$id}{lastGaveDate}\n" . " lastGave: $requestData{$id}{lastGaveDate}\n" .
" total: " . sprintf('%8.2f', $requestData{$id}{total}) ."\n" . " total: " . sprintf('%8.2f', $requestData{$id}{total}) ."\n" .
@ -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}}) { foreach my $type (sort { $requestData{$id}{shirts}{$a}{requestDate} cmp $requestData{$id}{shirts}{$b}{requestDate} } keys %{$requestData{$id}{shirts}}) {
my $outputType = $type; my $outputType = $type;
my $size = $requestData{$id}{shirts}{$type}{requestConfiguration}; my $size = $requestData{$id}{shirts}{$type}{requestConfiguration};
my $requestDate = $requestData{$id}{shirts}{$type}{requestDate};
print STDERR "Processing: $id, $type, $size, $requestDate\n" if $VERBOSE >= 1;
die "$id $type request has no size!" unless defined $size; die "$id $type request has no size!" unless defined $size;
last if $remainingQualifyingDonations < 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'; $outputType = 'any';
} elsif ($type =~ /2018/) { } elsif ($type =~ /2018/) {
$outputType = '2018design'; $outputType = '2018design';
} elsif ($type =~ /2021/) { } elsif ($type =~ /2021/) {
$outputType = '2021design'; $outputType = '2021design';
} elsif ($type =~ /2022/) {
$outputType = '2022design';
} elsif ($type =~ /2023/) {
$outputType = '2023design';
} elsif ($type =~ /vintage/) { } elsif ($type =~ /vintage/) {
$outputType = 'vintage'; $outputType = 'vintage';
} }
@ -186,40 +282,79 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
die "Supporter $id: $outputType: $type: $size: invalid size \"$size\"" die "Supporter $id: $outputType: $type: $size: invalid size \"$size\""
unless ($outputType ne 'any' and defined $sizeCounts->{$outputType}{$size}) unless ($outputType ne 'any' and defined $sizeCounts->{$outputType}{$size})
or ($outputType eq 'any' and defined $sizeCounts->{vintage}{$size}); or ($outputType eq 'any' and defined $sizeCounts->{vintage}{$size});
if ($outputType eq 'vintage' and $sizeCounts->{vintage}{$size} <= 0
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'; $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} = 0 unless defined $need{$outputType}{$size};
$need{$outputType}{$size}++; $need{$outputType}{$size}++;
next; 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!"; warn "Supporter $id: unable to find best postal address!";
next; next;
} }
%bestPostal = %$bb;
my $likelyUSA = 1 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"; warn "Support $id: CANNOT CURRENTLY SHIP TO RUSSIA";
next; next;
} }
@ -235,18 +370,35 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
$requestDates .= $requestData{$id}{shirts}{$type}{requestDate}; $requestDates .= $requestData{$id}{shirts}{$type}{requestDate};
# Order ID (required),Order Date,Order Value,Requested Service,Ship To - Name,Ship To - Company,Ship To - Address 1,Ship To - Address 2,Ship To - Address 3,Ship To - State/Province,Ship To - City,Ship To - Postal Code,Ship To - Country,Ship To - Phone,Ship To - Email,Total Weight in Oz,Dimensions - Length,Dimensions - Width,Dimensions - Height,Notes - From Customer,Notes - Internal,Gift Wrap?,Gift Message # Order ID (required),Order Date,Order Value,Requested Service,Ship To - Name,Ship To - Company,Ship To - Address 1,Ship To - Address 2,Ship To - Address 3,Ship To - State/Province,Ship To - City,Ship To - Postal Code,Ship To - Country,Ship To - Phone,Ship To - Email,Total Weight in Oz,Dimensions - Length,Dimensions - Width,Dimensions - Height,Notes - From Customer,Notes - Internal,Gift Wrap?,Gift Message
my $orderID = $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*//; $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) { 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 { } 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 ""; next if $requestDates eq "";
@ -261,7 +413,10 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) {
print "\n Request Dates: $requestDates\n"; print "\n Request Dates: $requestDates\n";
print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n"; print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n";
print " Display name: \"", $sp->getDisplayName($id), "\"\n"; print " Display name: \"", $sp->getDisplayName($id), "\"\n";
print " Postal Address:\n$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(); BeancountQueryComplete();
@ -293,20 +448,33 @@ if (defined $sizeCounts) {
print " ... includes subtotal of $type: $subtotals{$type}\n"; 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: # Local variables: