211 lines
8.6 KiB
Perl
211 lines
8.6 KiB
Perl
#!/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 <SUPPORTERS_SQLITE_DB_FILE> <GIVING_LIMIT> <T-SHIRT-STYLE> <SIZE_COUNTS> <OUTPUT_DIRECTORY > <MONTHLY_SEARCH_REGEX> <ANNUAL_SEARCH_REGEX> <VERBOSE> <LEDGER_CMD_LINE>\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(<<SUPPORTESR_DB_READ
|
|
SELECT ANY_META("program") as program, date, ANY_META("entity") as entity, NUMBER(COST(position))
|
|
WHERE account ~ "^Income" AND ANY_META("project") ~ "Conservancy"
|
|
AND ANY_META("program") ~ "Conservancy:Supporters:" AND NOT ANY_META("entity") ~ "^\\s*\$"
|
|
SUPPORTESR_DB_READ
|
|
, 'text');
|
|
open(my $fh, "<", $fileName);
|
|
my $sp = new Supporters($dbh, $fh, { monthly => $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:
|
|
|