From ca8348d84b38445bcb03ba1ff9898b3391193994 Mon Sep 17 00:00:00 2001 From: "Bradley M. Kuhn" Date: Mon, 21 Nov 2022 17:26:20 -0800 Subject: [PATCH] Rework various aspects of shirt label printing The primary change here is to add output such that we can get CSV output that can be later used in post-processing to upload the data to third-party shipping services. Various other changes are present as well, including changes to the logic related to which t-shirt to give when no specific type is requested. --- scripts/t-shirt-label-print.plx | 245 ++++++++++++++++++++++---------- 1 file changed, 173 insertions(+), 72 deletions(-) diff --git a/scripts/t-shirt-label-print.plx b/scripts/t-shirt-label-print.plx index 20955df..6a22abe 100644 --- a/scripts/t-shirt-label-print.plx +++ b/scripts/t-shirt-label-print.plx @@ -7,6 +7,7 @@ use warnings; use autodie qw(open close chdir); use DBI; use Encode qw(encode decode); +use Text::CSV; # libtext-csv-perl in Debian use YAML::XS qw(LoadFile); @@ -20,15 +21,27 @@ require 'bean-query-daemon-lib.pl'; binmode STDOUT, ":utf8"; BeancountQueryInitialize(); -if (@ARGV < 9) { - print STDERR "usage: $0 \n"; +if (@ARGV < 8 or @ARGV > 9) { + print STDERR "usage: $0 \n"; exit 1; } -my($SUPPORTERS_SQLITE_DB_FILE, $GIVING_LIMIT, $T_SHIRT_STYLE, $SIZE_COUNT_FILE, $OUTPUT_DIRECTORY, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $VERBOSE, @LEDGER_CMD_LINE) = @ARGV; +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; -my($sizeCounts) = LoadFile $SIZE_COUNT_FILE; +open(my $idsInUSAFH, "<", $ID_IN_USA_FILE); + +my %idsKnownToBeInUSA; + +while (my $idInUSA = <$idsInUSAFH>) { + chomp $idInUSA; + $idsKnownToBeInUSA{$idInUSA} = 1; +} + +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 }) @@ -50,8 +63,10 @@ my %lines; my @typeList; my @oldTypeList; -if ($T_SHIRT_STYLE eq 'fy2021design') { - @typeList = qw/t-shirt-fy2022design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/; +if ($T_SHIRT_STYLE eq 'ONLY-fy2021design') { + @typeList = qw/t-shirt-fy2021design-0/; +} elsif ($T_SHIRT_STYLE eq 'fy2021design') { + @typeList = qw/t-shirt-fy2021design-0 t-shirt-fy2018design-0 t-shirt-vintage-0/; @oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/; } elsif ($T_SHIRT_STYLE eq 'fy2018design') { @typeList = qw/t-shirt-fy2018design-0 t-shirt-vintage-0/; @@ -80,10 +95,6 @@ foreach my $id (@supporterIds) { $requestData{$id}{lastGaveDate} = $lastGaveDate unless defined $requestData{$id}{lastGaveDate}; $requestData{$id}{oldestShirtDate} = '9999-12-31' unless defined $requestData{$id}{oldestShirtDate}; $requestData{$id}{forSortingbySize} = "" unless defined $requestData{$id}{forSortingbySize}; - $requestData{$id}{forSorting_trueVintageCount} = 0 unless defined $requestData{$id}{forSorting_trueVintageCount}; - - $requestData{$id}{forSorting_trueVintageCount}++ if ($type =~ /vint/i); - print STDERR "$id: $type, need vint $requestData{$id}{forSorting_trueVintageCount}\n" if ($type =~ /vint/i); $requestData{$id}{shirts}{$request->{requestType}} = $request; $requestData{$id}{forSortingbySize} = $request->{requestConfiguration} @@ -93,83 +104,126 @@ foreach my $id (@supporterIds) { } } } -sub sortFunction($$) { ($requestData{$_[1]}{forSorting_trueVintageCount} <=> $requestData{$_[0]}{forSorting_trueVintageCount}) or - (($requestData{$_[0]}{lastGaveDate} ge '2020-11-01') - <=> ($requestData{$_[1]}{lastGaveDate} ge '2020-11-01')) or - return ( ($requestData{$_[0]}{oldestShirtDate} cmp $requestData{$_[1]}{oldestShirtDate} or - $requestData{$_[0]}{lastGaveDate} cmp $requestData{$_[1]}{lastGaveDate}) or - ($requestData{$_[0]}{forSortingbySize} cmp $requestData{$_[1]}{forSortingbySize}) or - ($_[0] <=> $_[1])); +sub sortFunction($$) { return (($requestData{$_[1]}{total} <=> $requestData{$_[0]}{total}) or + ($requestData{$_[1]}{lastGaveDate} cmp $requestData{$_[0]}{lastGaveDate}) or + ($requestData{$_[0]}{oldestShirtDate} cmp $requestData{$_[1]}{oldestShirtDate}) or + ($requestData{$_[0]}{forSortingbySize} cmp $requestData{$_[1]}{forSortingbySize}) or + ($_[0] <=> $_[1])); } my %need; foreach my $id (sort { sortFunction($a, $b); } keys %requestData) { - my %emails; - my $email = $sp->getPreferredEmailAddress($id); - if (defined $email) { - $emails{$email} = {}; - } else { - %emails = $sp->getEmailAddresses($id); - } - my(@emails) = keys(%emails); + next if $id == 20 or $id == 70 or $id == 670 or $id == 34; - next if $id == 20; # Skip bkuhn, he can wait forever for shirts if needed. - my $bestPostal = $sp->getBestPostalAddress($id); - unless (defined $bestPostal) { - warn "Supporter $id: unable to find best postal address!"; - next; + 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) { + push(@emails, $possibleEmail); + print STDERR "$emails{$email}{date_encountered} gt $bestDate\n"; + if ($emails{$possibleEmail}{date_encountered} gt $bestDate) { + $email = $possibleEmail; $bestDate = $emails{$possibleEmail}{date_encountered}; + } + } + } else { + @emails = qw/$email/; } - my $hasOrGets2018 = 0; - my $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2018design-0', ignoreHeldRequests => 1}); - $hasOrGets2018 = 1 if (defined $request); + print STDERR "Supporter $id has no email address\n" if not defined $email; + + my($specificRequest2018, $specificRequest2021) = (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; my $remainingQualifyingDonations = $requestData{$id}{total}; next if $remainingQualifyingDonations < 60.00; # Must have given at least $60 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" . " emails: " . join(", ", @emails) . "\n" . + " email_for_ship: " . $email . "\n" . " shirts: $id,"; + my @shirtTypes; my $requestDates = ""; + my($finalOutputType, $finalSize); 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}; die "$id $type request has no size!" unless defined $size; last if $remainingQualifyingDonations < 60.00; - if ($hasOrGets2018) { - if ($type =~ /2018/) { - $outputType = "2018design"; - } elsif ($type =~ /vint/i) { - $outputType = "vintage"; - } else { - $outputType = "any"; - } - } elsif ($type !~ /vint/i) { - $outputType = "2018design"; - $hasOrGets2018 = 1; + $remainingQualifyingDonations -= 60.00; + if ($type !~ /(2018|2021|vintage)/) { + $outputType = 'any'; + } elsif ($type =~ /2018/) { + $outputType = '2018design'; + } elsif ($type =~ /2021/) { + $outputType = '2021design'; + } elsif ($type =~ /vintage/) { + $outputType = 'vintage'; } + #if ($wantedOrGotBoth2018And2021) { + # if ($type =~ /2018/) { + # if ($type =~ /2018/) { + # $outputType = "2018design"; + # } elsif ($type =~ /2021/) { + # $outputType = "2021design"; + # } elsif ($type =~ /vint/i) { + # $outputType = "vintage"; + # } else { + # $outputType = "any"; + # } + # } elsif ($type !~ /vint/i) { + # $outputType = "2021design"; + # } else { + # $outputType = "vintage"; + # } $size = "Standard$size" if $size =~ /^Ladies/; + # The commented out code below is designed to handle the sizeCounts and make best guess about what + # shirt to send. 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 'any' and $sizeCounts->{vintage}{$size} > 0) { + 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 $sizeCounts->{'vintage-green'}{$size} > 0 and $hasOrGets2018) { - $outputType = 'vintage'; - } elsif ($outputType eq 'any') { + } elsif ($outputType eq 'any' and $specificRequest2018) { + $outputType = '2021design'; + } elsif ($outputType eq 'any' and $specificRequest2021) { $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; + } + } } - die "Supporter $id: $outputType: $type: $size: How are we still any?" if $outputType eq 'any'; - if ($sizeCounts->{$outputType}{$size} < 0) { - die "Somehow size count for $outputType, $size got to be less than zero!!!"; - } elsif ($sizeCounts->{$outputType}{$size} == 0) { + 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) { $need{$outputType}{$size} = 0 unless defined $need{$outputType}{$size}; $need{$outputType}{$size}++; - if ($outputType eq 'vintage') { - warn "Supporter $id: $type: $size: needs a vintage shirt *specifically* which we do not have"; - } - $remainingQualifyingDonations -= 60.00; next; } - # Continue on only if we have sizes left + $bestPostal = $sp->getBestPostalAddress($id); + unless (defined $bestPostal) { + warn "Supporter $id: unable to find best postal address!"; + next; + } + 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) { + warn "Support $id: CANNOT CURRENTLY SHIP TO RUSSIA"; + next; + } + # # Continue on only if we have sizes left $sizeCounts->{$outputType}{$size}--; $totalSent++; if ($requestDates ne "") { @@ -177,11 +231,33 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) { $outputSoFar .= ","; } $outputSoFar .= "${size}_$outputType"; + push(@shirtTypes, $type); $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); + $orderID =~ s/\s*//; + my $outputAddress = join(" ", split /\n/, $bestPostal); + $outputAddress = $bestPostal; + if ($likelyUSA) { + push(@usaRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, + sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email, + "USA", $outputAddress ] ); + } else { + push(@intRows, [ $orderID, $requestData{$id}{shirts}{$type}{requestDate}, + sprintf('%s_%s_%4.4d', $size, $outputType, $id), $size, $email, + "International", $outputAddress ] ); + } } next if $requestDates eq ""; + my $shirtTypes; + foreach my $type (sort { $a cmp $b } @shirtTypes) { + $shirtTypes .= "," if defined $shirtTypes; + $shirtTypes = " SHIRT_TYPES: " if not defined $shirtTypes; + $shirtTypes .= $type; + } print "#" x 75; - print "\n$outputSoFar"; + print "\n$outputSoFar\n$shirtTypes\n"; print "\n Request Dates: $requestDates\n"; print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n"; print " Display name: \"", $sp->getDisplayName($id), "\"\n"; @@ -190,22 +266,47 @@ foreach my $id (sort { sortFunction($a, $b); } keys %requestData) { BeancountQueryComplete(); my $totalNeed = 0; -print "FINAL INVENTORY\n"; -foreach my $type (sort { $a cmp $b } keys %$sizeCounts) { - print "$type:\n"; - foreach my $size (sort { $a cmp $b } keys %{$sizeCounts->{$type}}) { - print " $size: $sizeCounts->{$type}{$size}\n"; +my %subtotals; +if (defined $sizeCounts) { + print "FINAL INVENTORY\n"; + foreach my $type (sort { $a cmp $b } keys %$sizeCounts) { + print "$type:\n"; + foreach my $size (sort { $a cmp $b } keys %{$sizeCounts->{$type}}) { + print " $size: $sizeCounts->{$type}{$size}\n"; + } + } + print "NEED INVENTORY\n"; + foreach my $type (sort { $a cmp $b } keys %need) { + print "$type:\n"; + $subtotals{$type} = 0; + foreach my $size (sort { $a cmp $b } keys %{$need{$type}}) { + print " $size: $need{$type}{$size}\n"; + $totalNeed += $need{$type}{$size}; + $subtotals{$type} += $need{$type}{$size} + } } } -print "NEED INVENTORY\n"; -foreach my $type (sort { $a cmp $b } keys %need) { - print "$type:\n"; - foreach my $size (sort { $a cmp $b } keys %{$need{$type}}) { - print " $size: $need{$type}{$size}\n"; - $totalNeed += $need{$type}{$size}; - } +print "TOTAL SENT: $totalSent "; +if (defined $sizeCounts) { + print "\n\nTOTAL NEED: $totalNeed\n"; + foreach my $type (sort { $a cmp $b } keys %need) { + print " ... includes subtotal of $type: $subtotals{$type}\n"; + } } -print "TOTAL SENT: $totalSent ; TOTAL NEED: $totalNeed\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; + ############################################################################### # # Local variables: