#!/usr/bin/perl # License: AGPL-3.0-or-later use strict; use warnings; use autodie qw(open close chdir); use DBI; use Encode qw(encode decode); use YAML::XS qw(LoadFile); use LaTeX::Encode; use Supporters; use utf8; use IPC::Shareable; require 'bean-query-daemon-lib.pl'; binmode STDOUT, ":utf8"; BeancountQueryInitialize(); if (@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; $VERBOSE = 0 if not defined $VERBOSE; my($sizeCounts) = LoadFile $SIZE_COUNT_FILE; my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "", { RaiseError => 1, sqlite_unicode => 1 }) or die $DBI::errstr; 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 '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 { die "Unknown t-shirt style given: $T_SHIRT_STYLE"; } 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}{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} 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($$) { ($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])); } 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; # 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 $hasOrGets2018 = 0; my $request = $sp->getRequest({ donorId => $id, requestType => 't-shirt-fy2018design-0', ignoreHeldRequests => 1}); $hasOrGets2018 = 1 if (defined $request); 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" . " shirts: $id,"; my $requestDates = ""; 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; } $size = "Standard$size" if $size =~ /^Ladies/; 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) { $outputType = 'vintage'; } elsif ($outputType eq 'any' and $sizeCounts->{'vintage-green'}{$size} > 0 and $hasOrGets2018) { $outputType = 'vintage'; } elsif ($outputType eq 'any') { $outputType = '2018design'; } 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) { $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 $sizeCounts->{$outputType}{$size}--; $totalSent++; if ($requestDates ne "") { $requestDates .= ", "; $outputSoFar .= ","; } $outputSoFar .= "${size}_$outputType"; $requestDates .= $requestData{$id}{shirts}{$type}{requestDate}; } next if $requestDates eq ""; print "#" x 75; print "\n$outputSoFar"; 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"; } 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"; } } 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 ; TOTAL NEED: $totalNeed\n"; ############################################################################### # # Local variables: # compile-command: "perl -c t-shirts-label-print.plx" # End: