2016-01-02 19:21:17 +00:00
#!/usr/bin/perl
use strict;
use warnings;
use autodie qw(open close chdir);
use DBI;
use Encode qw(encode decode);
use LaTeX::Encode;
use Supporters;
my $LEDGER_CMD = "/usr/local/bin/ledger";
2017-08-01 17:17:19 +00:00
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";
2016-01-02 19:21:17 +00:00
exit 1;
}
2017-08-01 17:17:19 +00:00
my($SUPPORTERS_SQLITE_DB_FILE, $GIVING_LIMIT, $T_SHIRT_STYLE, $SIZE_COUNTS, $OUTPUT_DIRECTORY, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $VERBOSE, @LEDGER_CMD_LINE) = @ARGV;
2016-01-02 19:21:17 +00:00
$VERBOSE = 0 if not defined $VERBOSE;
open(SIZE_COUNTS, "<", $SIZE_COUNTS);
my %sizeCounts;
while (my $line = <SIZE_COUNTS>) {
2016-12-09 21:47:02 +00:00
next if ($line =~ /^\s*#/ or $line =~ /^\s*$/);
2016-01-02 19:21:17 +00:00
if ($line =~ /^\s*(\S+)\s+(\d+)\s*/) {
my($size, $count) = ($1, $2, $3);
$sizeCounts{$size} = $count;
} else {
die "invalid line $line in $SIZE_COUNTS file";
}
}
close SIZE_COUNTS;
open(LIST, ">checklist-ready-to-send.tex") or die "unable to open list: $!";
open(LABELS, ">labels-ready-to-send.tex") or die "unable to open labels: $!";
print LIST <<LIST_HEADER
\\documentclass[letterpaper, 10pt]{letter}
\\usepackage{units}
\\usepackage{color}
\\usepackage{wasysym}
\\usepackage{latexsym}
\\usepackage{amsfonts}
\\usepackage{amssymb}
2016-05-27 13:08:36 +00:00
\\usepackage[T1]{fontenc}
2016-01-02 19:21:17 +00:00
\\begin{document}
\\vspace{-15in}
\\begin{tabular}{|l|l|l|l|l|} \\hline
LIST_HEADER
;
my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
{ RaiseError => 1, sqlite_unicode => 1 })
or die $DBI::errstr;
2016-01-23 01:10:58 +00:00
my $sp = new Supporters($dbh, \@LEDGER_CMD_LINE, { monthly => $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX});
2016-01-02 19:21:17 +00:00
my(@supporterIds) = $sp->findDonor({});
2016-01-07 05:46:58 +00:00
my $overallCount = 0;
2016-01-07 20:42:51 +00:00
my %lines;
2016-01-07 05:46:58 +00:00
2016-05-27 03:38:48 +00:00
sub sortFunction($$) {
my $lastGaveDate0 = $sp->donorLastGave($_[0]);
my $lastGaveDate1 = $sp->donorLastGave($_[1]);
my $ledgerEntityId0 = $sp->getLedgerEntityId($_[0]);
my $ledgerEntityId1 = $sp->getLedgerEntityId($_[1]);
my $type0 = $sp->{ledgerData}{$ledgerEntityId0}{__TYPE__};
my $type1 = $sp->{ledgerData}{$ledgerEntityId1}{__TYPE__};
2016-05-27 03:40:24 +00:00
if ( (defined $type0 and $type0 =~ /month/i) or (defined $type1 and $type1 =~ /month/i)) {
2016-05-27 03:38:48 +00:00
return ($_[0] <=> $_[1]);
} else {
return ($lastGaveDate0 cmp $lastGaveDate1);
}
}
2017-08-01 17:17:19 +00:00
my @typeList;
if ($T_SHIRT_STYLE == 0) {
@typeList = qw/t-shirt-0 t-shirt-extra-0/;
} elsif ($T_SHIRT_STYLE == 1) {
@typeList = qw/t-shirt-1 t-shirt-extra-1/;
} else {
die "Unknown t-shirt style given: $T_SHIRT_STYLE";
}
2016-05-27 03:38:48 +00:00
foreach my $id (sort { sortFunction($a, $b); } @supporterIds) {
2016-01-02 19:21:17 +00:00
my $sizeNeeded;
2017-08-01 19:13:10 +00:00
foreach my $type (@typeList) {
2016-12-08 23:08:53 +00:00
my $request = $sp->getRequest({ donorId => $id, requestType => $type,
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
2016-01-02 19:21:17 +00:00
if (defined $request and defined $request->{requestType}) {
$sizeNeeded = $request->{requestConfiguration};
last;
}
}
next if not defined $sizeNeeded; # If we don't need a size, we don't have a request.
2016-01-08 21:10:20 +00:00
my $amount = $sp->donorTotalGaveInPeriod(donorId => $id);
if ($amount < $GIVING_LIMIT) {
2016-01-23 01:10:45 +00:00
print "Skipping $id request for $sizeNeeded because donor only gave $amount and giving limit is $GIVING_LIMIT\n" if $VERBOSE;
2016-01-08 21:10:20 +00:00
next;
}
2016-12-17 19:35:56 +00:00
my $postalAddress = $sp->getPreferredPostalAddress($id);
2016-05-27 04:04:43 +00:00
if (not defined $postalAddress) {
my(@postalAddresses) = $sp->getPostalAddresses($id);
$postalAddress = $postalAddresses[0];
}
my $latexPostal = latex_encode($postalAddress);
2016-05-27 04:09:50 +00:00
$latexPostal =~ s/\\unmatched\{0141\}/\L{}/g;
$latexPostal =~ s/\\unmatched\{0142\}/\l{}/g;
2016-01-02 19:21:17 +00:00
if ($latexPostal =~ /unmatched/) {
2016-05-27 04:04:43 +00:00
print "Skipping $id request for $sizeNeeded because the address has characters the post office will not accept\n Address was: ", encode('UTF-8', $postalAddress), "\n and became\n$latexPostal\n" if $VERBOSE;
2016-01-02 19:21:17 +00:00
next;
}
{ no strict; no warnings; $sizeCounts{$sizeNeeded}--; }
2016-01-07 05:46:58 +00:00
if ($sizeCounts{$sizeNeeded} < 0) {
2016-01-02 19:21:17 +00:00
print STDERR "Skipping $id request for $sizeNeeded because we are out.\n" if $VERBOSE;
next;
}
2016-01-07 05:46:58 +00:00
$overallCount++;
2016-01-07 20:42:51 +00:00
$lines{$sizeNeeded}{labels} = "" unless defined $lines{$sizeNeeded}{labels};
$lines{$sizeNeeded}{checklist} = [] unless defined $lines{$sizeNeeded}{checklist};
$lines{$sizeNeeded}{labels} .= '\mlabel{}{TO: \\\\ ' . join(' \\\\ ', split('\n', $latexPostal)) . "}\n";
2016-05-27 04:04:43 +00:00
my $shortLatexPostal = latex_encode(sprintf('%-30.30s', join(" ", reverse split('\n', $postalAddress))));
2016-05-27 13:02:17 +00:00
$shortLatexPostal =~ s/\\unmatched\{0141\}/\L{}/g;
$shortLatexPostal =~ s/\\unmatched\{0142\}/\l{}/g;
2016-01-23 01:10:09 +00:00
push(@{$lines{$sizeNeeded}{checklist}}, '{ $\Box$} &' . sprintf("%-3d & %5s & %-30s & %s ",
2016-01-07 20:33:52 +00:00
$id, encode('UTF-8', $sp->getLedgerEntityId($id)),
encode('UTF-8', $sizeNeeded),
$shortLatexPostal) .
'\\\\ \hline' . "\n");
}
my $lineCount = 0;
2016-01-07 20:42:51 +00:00
foreach my $size (sort { $a cmp $b } keys %lines) {
2016-01-23 01:10:09 +00:00
foreach my $line (@{$lines{$size}{checklist}}) {
2016-01-07 20:33:52 +00:00
if ($lineCount++ > 40) {
$lineCount = 0;
print LIST "\n\n", '\end{tabular}',"\n\\pagebreak\n\\begin{tabular}{|l|l|l|l|l|} \\hline\n";
}
print LIST $line;
}
2016-01-07 20:42:51 +00:00
print LABELS $lines{$size}{labels};
delete $lines{$size}{labels};
2016-01-02 19:21:17 +00:00
}
2016-01-07 20:33:52 +00:00
2016-01-02 19:21:17 +00:00
print LIST "\n\n", '\end{tabular}',"\n";
print LIST "FINAL INVENTORY EXPECTED\n\\begin{tabular}{|l|l|} \\hline\n";
2016-01-07 05:46:58 +00:00
print STDERR "Total Shirts: $overallCount\n" if $VERBOSE;
2016-01-02 19:21:17 +00:00
2016-01-07 05:46:58 +00:00
my %needList;
foreach my $size (sort keys %sizeCounts) {
if ($sizeCounts{$size} < 0) {
$needList{$size} = abs($sizeCounts{$size});
$sizeCounts{$size} = 0;
}
2016-01-02 19:21:17 +00:00
print LIST "$size & $sizeCounts{$size}\\\\\n";
}
2016-05-27 04:03:54 +00:00
my $overallNeed = 0;
2016-01-07 05:46:58 +00:00
if (scalar(keys %needList) > 0) {
print LIST "\\hline \n\n", '\end{tabular}',"\n\n\\bigskip\n\n";
print LIST "T-SHIRTS NEEDED\n\\begin{tabular}{|l|l|} \\hline\n";
foreach my $size (sort keys %needList) {
print LIST "$size & $needList{$size}\\\\\n";
2016-05-27 04:03:54 +00:00
$overallNeed += $needList{$size};
2016-01-07 05:46:58 +00:00
}
}
2016-05-27 04:03:54 +00:00
print LIST "\\hline \n\n", '\end{tabular}',"\n\n\nOVERALL SENDING COUNT: $overallCount",
"\n\nOVERAL NEED COUNT: $overallNeed\n", '\end{document}', "\n";
2016-01-02 19:21:17 +00:00
close LIST;
close LABELS;
###############################################################################
#
# Local variables:
2016-05-27 03:39:58 +00:00
# compile-command: "perl -c t-shirts-label-print.plx"
2016-01-02 19:21:17 +00:00
# End: