#!/usr/bin/perl # License: AGPL-3.0-or-later 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"; 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'); 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 $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "", { RaiseError => 1, sqlite_unicode => 1 }) or die $DBI::errstr; BeancountQueryInitialize($GLUE); my $fileName = BeancountQuerySubmit(< $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX}); my(@supporterIds) = $sp->findDonor({}); my $overallCount = 0; my %lines; my @typeList; my @oldTypeList; 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/; } 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') { @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/; @oldTypeList = qw/t-shirt-0 t-shirt-1 t-shirt-extra-0 t-shirt-extra-1/; } elsif ($T_SHIRT_STYLE == 0) { @typeList = qw/t-shirt-0 t-shirt-extra-0/; } elsif ($T_SHIRT_STYLE == 1) { @oldTypeList = qw/t-shirt-0 t-shirt-extra-0/; @typeList = qw/t-shirt-1 t-shirt-extra-1/; } else { UsageAndExit("--tShirtStyle must be a known t-shirt style setting; $T_SHIRT_STYLE is unknown"); } my %requestData; my $totalSent = 0; foreach my $id (@supporterIds) { my $lastGaveDate = $sp->donorLastGave($id); my $totalDonated = $sp->donorTotalGaveInPeriod(donorId => $id); $lastGaveDate = "0000-01-01" if not defined $lastGaveDate; my $ledgerEntityId = $sp->getLedgerEntityId($id); foreach my $type (@typeList, @oldTypeList) { my $request = $sp->getRequest({ donorId => $id, requestType => $type, ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 }); if (defined $request and defined $request->{requestType}) { $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}{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}{forSortingbySize} = $request->{requestConfiguration} if ($requestData{$id}{forSortingbySize} eq "" and defined $request->{requestConfiguration}); $requestData{$id}{oldestShirtDate} = $request->{requestDate} if ($request->{requestDate} lt $requestData{$id}{oldestShirtDate}); $requestData{$id}{total} = $totalDonated; } } } 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) { 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); 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}; } } } else { @emails = qw/$email/; } print STDERR "Supporter $id has no email address\n" if not defined $email; 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); $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-cy2022design-0' }); $specificRequest2022 = (defined $request); my %bestPostal; my $remainingQualifyingDonations = $requestData{$id}{total}; 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" . " 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}; 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 < $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'; } #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}); # 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 =~ /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'; } 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; } my $bb = $sp->getBestPostalAddress($id); unless (defined $bb) { warn "Supporter $id: unable to find best postal address!"; next; } %bestPostal = %$bb; my $likelyUSA = 1 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; } # # Continue on only if we have sizes left $sizeCounts->{$outputType}{$size}--; $totalSent++; if ($requestDates ne "") { $requestDates .= ", "; $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 = ""; $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 $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}, $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}, $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 ""; 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\n$shirtTypes\n"; print "\n Request Dates: $requestDates\n"; print " LedgerEntityId: ", $sp->getLedgerEntityId($id), "\n"; print " Display name: \"", $sp->getDisplayName($id), "\"\n"; print " Postal Address:\n"; foreach my $key (keys %bestPostal) { print " $key: $bestPostal{$key}\n" if (defined $bestPostal{$key} and NotBlank($bestPostal{$key})); } } BeancountQueryComplete(); my $totalNeed = 0; 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 "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"; } } 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: # compile-command: "perl -c t-shirts-label-print.plx" # End: