From 31961b997c702f2c7a59c437397e2cd5a3a04599 Mon Sep 17 00:00:00 2001 From: "Bradley M. Kuhn" Date: Sun, 3 Nov 2024 15:53:08 -0800 Subject: [PATCH] Various changes from last time t-shirts were shipped. I had made various changes the last time we shipped t-shirts, but had never committed them. These are those changes. --- scripts/send-t-shirts.plx | 278 ++++++++++++++------------- scripts/t-shirt-label-print.plx | 322 ++++++++++++++++++++++++-------- 2 files changed, 392 insertions(+), 208 deletions(-) diff --git a/scripts/send-t-shirts.plx b/scripts/send-t-shirts.plx index e159284..2fff689 100644 --- a/scripts/send-t-shirts.plx +++ b/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 $id = shift @vals; - $info{$id} = $row; + 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}; - $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'; + 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 { - 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) { - my $request = $sp->getRequest({ donorId => $id, requestType => $type, - ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 }); + 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{$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'; - 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 $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) { - $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $thisHow}); - $sentData .= "A $size t-shirt in the vintage design. "; + 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}{$shirtType}; + delete $info{$id}{shirts}{$type}; } } } - 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"; + 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}; + } } } - my %emails; - my $email = $sp->getPreferredEmailAddress($id); - if (defined $email) { - $emails{$email} = {}; - } else { - %emails = $sp->getEmailAddresses($id); + 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"; } - 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); } ############################################################################### # diff --git a/scripts/t-shirt-label-print.plx b/scripts/t-shirt-label-print.plx index 6a22abe..d2d0cb6 100644 --- a/scripts/t-shirt-label-print.plx +++ b/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(); -if (@ARGV < 8 or @ARGV > 9) { - print STDERR "usage: $0 \n"; - exit 1; +my($CONSERVANCY_REPOSITORY, $SUPPORTERS_SQLITE_DB_FILE, $VERBOSE, $SERIAL_ORDER_START, $ORDER_PREFIX, + $T_SHIRT_VALUE, $GIVING_LIMIT, $T_SHIRT_STYLE, $SIZE_COUNT_FILE, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $GLUE) = + ($ENV{CONSERVANCY_REPOSITORY}, undef, 0, 0, undef, + 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; -$VERBOSE = 0 if not defined $VERBOSE; - -open(my $idsInUSAFH, "<", $ID_IN_USA_FILE); - -my %idsKnownToBeInUSA; - -while (my $idInUSA = <$idsInUSAFH>) { - chomp $idInUSA; - $idsKnownToBeInUSA{$idInUSA} = 1; +if ($CONSERVANCY_REPOSITORY ne $ENV{CONSERVANCY_REPOSITORY} and not -d $CONSERVANCY_REPOSITORY) { + UsageAndExit("provided --conservancyRepository is not a directory"); +} elsif ($CONSERVANCY_REPOSITORY eq $ENV{CONSERVANCY_REPOSITORY} and not -d $CONSERVANCY_REPOSITORY) { + UsageAndExit("CONSERANCY_REPOSITORY from the environment variable, $ENV{CONSERANCY_REPOSITORY}, is not a directory. Use --conservancyRepository or change the environment variable."); } +$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(<{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 - ($requestData{$_[1]}{lastGaveDate} cmp $requestData{$_[0]}{lastGaveDate}) or +sub sortFunction($$) { return (($requestData{$_[0]}{forSortingbyType} cmp $requestData{$_[1]}{forSortingbyType}) 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; - $remainingQualifyingDonations -= 60.00; - if ($type !~ /(2018|2021|vintage)/) { + last if $remainingQualifyingDonations < $GIVING_LIMIT; + $remainingQualifyingDonations -= $GIVING_LIMIT; + 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) { - $outputType = 'vintage-green'; - } elsif ($outputType eq 'any' and $specificRequest2021 and $specificRequest2018) { - $outputType = 'vintage'; - } elsif ($outputType eq 'any' and $specificRequest2018) { - $outputType = '2021design'; - } elsif ($outputType eq 'any' and $specificRequest2021) { + + # When fixing this, note that If folks got *any* shirt recently (since + # 2022-10-15), then they were told they would get the cy2022 design next, + # so favor giving them that one for any non-specific request + + # if ($outputType eq 'vintage' and $sizeCounts->{vintage}{$size} <= 0 + # and defined $sizeCounts->{'vintage-green'} and $sizeCounts->{'vintage-green'}{$size} > 0) { + # $outputType = 'vintage-green'; + # } elsif ($outputType eq 'any' and (not $specificRequest2022)) { + # # Latter dates are for people who just never got a 2018 + # if ($sizeCounts->{'2018design'}{$size} > 0 and (not $specificRequest2018)) { + # $outputType = '2018design'; + # } else { + # $outputType = '2022design'; + # } + # } elsif ($outputType eq 'any' and (not $specificRequest2021) and $requestDate gt '2020-03-01' and $requestDate lt '2021-01-01') { + # $outputType = '2021design'; + # } elsif ($outputType eq 'any' and $specificRequest2021 and $specificRequest2018 and (not $specificRequest2022)) { + # $outputType = '2022design'; + # } elsif ($outputType eq 'any' and $specificRequest2021 and $sizeCounts->{'2018design'}{$size} > 0) { + # $outputType = '2018design'; + # } elsif ($outputType eq 'any' and $sizeCounts->{vintage}{$size} > 0 + # and ($specificRequest2021 or ($sizeCounts->{'2021design'}{$size} < 2 + # and $size =~ /^\s*(Men)\s*[LM]\s*$/))) { + # $outputType = 'vintage'; + # } elsif ($outputType eq 'any' and $sizeCounts->{'2018design'}{$size} > 0 and (not $specificRequest2018)) { + # $outputType = '2018design'; + # } elsif ($outputType eq 'any' and $specificRequest2018 and $sizeCounts->{'2021design'}{$size} > 0) { + # $outputType = '2021design'; + # } elsif ($outputType eq 'any') { + # foreach my $reType (qw/2022design vintage-green vintage 2018design 2021design/) { + # if ($sizeCounts->{$reType}{$size} > 0 or $reType eq '2022design') { + # print "$id: bkuhn Using $outputType request as $reType\n"; + # $outputType = $reType; + # last; + # } + # } + # } + # if ($outputType ne 'any' and $sizeCounts->{$outputType}{$size} < 0) { + # die "Somehow size count for $outputType, $size got to be less than zero!!!"; + # } elsif ($outputType eq 'any' or $sizeCounts->{$outputType}{$size} == 0) { + if ($outputType =~ /any/ and (not $specificRequest2022)) { + $outputType = '2022design'; + } elsif ($outputType =~ /2018/) { $outputType = '2018design'; - } elsif ($outputType eq 'any') { - foreach my $reType (qw/2021design 2018design vintage-green vintage/) { - if ($sizeCounts->{$reType}{$size} > 0) { - print "$id: bkuhn Using $outputType request as $reType\n"; - $outputType = $reType; - last; - } - } + } elsif ($outputType =~ /2021/) { + $outputType = '2021design'; + } elsif ($outputType eq 'any' and (not $specificRequest2018) and $sizeCounts->{'2018design'}{$size} > 0) { + $outputType = '2018design'; + } elsif ($outputType eq 'any' and (not $specificRequest2021) and $sizeCounts->{'2021design'}{$size} > 0) { + $outputType = '2021design'; + } elsif ($outputType eq 'any' and $sizeCounts->{vintage}{$size} > 0) { + $outputType = 'vintage'; + } elsif ($outputType eq 'any' and $specificRequest2018 and $specificRequest2021 and $specificRequest2022) { + $outputType = 'HAVETHEMALLANDWANTMORE'; } - 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) { + print "KAREN output $outputType\n" if $id == 34; + + 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); - unless (defined $bestPostal) { + my $bb = $sp->getBestPostalAddress($id); + 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 - and (not $bestPostal =~ /Saudi\s*Arabia|France|Sweden|Uruguay|Bulgaria|Indonesia|Switzerland|Spain|Brasil|Brazil|Estonia|Germany|Bosnia|Herzegovina|Italy|Czech|Finland|Korea|Ireland|Israel/im))); - if (not $likelyUSA and $bestPostal =~ /Russia/im) { + if (not NotBlank($bestPostal{country}) or $bestPostal{country} =~ /^\s*U\s*S\s*A?/i); + if (not $likelyUSA and $bestPostal{country} =~ /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); - $outputAddress = $bestPostal; + my $name = ""; + 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}, - sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email, - "USA", $outputAddress ] ); + push(@usaRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, $T_SHIRT_VALUE, "Domestic USPS Large Envelope", + $name, $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 ]); + # 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}, - sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email, - "International", $outputAddress ] ); + push(@intRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, $T_SHIRT_VALUE, "International Large Envelope", + ($name . " - " . $outputType . " $size"), + $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 $intFH, ">:encoding(utf8)", "international.csv"; - -my $usaCSV = Text::CSV->new({ binary => 1, quote_char => '"', allow_whitespace => 1, always_quote => 1, - sep_char => ',', escape_char => "\\", auto_diag => 2, diag_verbose => 2 }); -my $intCSV = Text::CSV->new({ binary => 1, quote_char => '"', allow_whitespace => 1, always_quote => 1, - sep_char => ',', escape_char => "\\", auto_diag => 2, diag_verbose => 2 }); - -my @headers = qw/orderId orderDate myReference size email usaOrInt formattedAddress/; -$usaCSV->say($usaFH, \@headers); -$intCSV->say($intFH, \@headers); -$usaCSV->say($usaFH, $_) for @usaRows; close $usaFH; -$intCSV->say($intFH, $_) for @intRows; close $intFH; +open my $usaFH, ">:encoding(utf8)", "first-pass_usa.csv"; +open my $intFH, ">:encoding(utf8)", "first-pass_international.csv"; +# 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: