Versions as used for the last time we sent t-shirts.
This commit is contained in:
Bradley M. Kuhn
parent
10e68afa95
commit
bdd100540a
2 changed files with 337 additions and 224 deletions
|
|
@ -3,81 +3,205 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use autodie qw(open close);
|
||||
use autodie qw(:all);
|
||||
|
||||
use Getopt::Long;
|
||||
use DBI;
|
||||
use Encode qw(encode decode);
|
||||
use File::Spec::Functions;
|
||||
use Time::HiRes qw(usleep nanosleep);
|
||||
|
||||
use Text::CSV; # libtext-csv-perl in Debian
|
||||
use Supporters;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use autodie qw(open close chdir);
|
||||
use DBI;
|
||||
use Encode qw(encode decode);
|
||||
|
||||
use Email::MIME::RFC2047::Encoder;
|
||||
use Email::MIME;
|
||||
use LaTeX::Encode;
|
||||
|
||||
use Supporters;
|
||||
use utf8;
|
||||
use IPC::Shareable;
|
||||
use Email::MIME::RFC2047::Encoder;
|
||||
|
||||
my $FROM_ADDRESS = 'info@sfconservancy.org';
|
||||
|
||||
require 'bean-query-daemon-lib.pl';
|
||||
my $encoder = Email::MIME::RFC2047::Encoder->new();
|
||||
my $LEDGER_CMD = "/usr/local/bin/ledger";
|
||||
|
||||
if (@ARGV != 5 and @ARGV != 6) {
|
||||
print STDERR "usage: $0 <SUPPORTERS_SQLITE_DB_FILE> <T_SHIRT_TYPE> <WHO> <HOW> <SUPPORTER_CHECKLIST_TEX_FILE> <VERBOSITY_LEVEL>\n";
|
||||
exit 1;
|
||||
binmode STDOUT, ":utf8";
|
||||
binmode STDERR, ":utf8";
|
||||
|
||||
my($VERBOSE, $stampsComCsvFile, $WHO, $EMAIL_TEMPLATE_FILE, $SUPPORTERS_SQLITE_DB_FILE) =
|
||||
(0, undef, undef,undef, catfile($ENV{CONSERVANCY_REPOSITORY},
|
||||
'Financial', 'Ledger', 'supporters.db'));
|
||||
GetOptions("verbose=i" => \$VERBOSE, "supporterDB=s" => \$SUPPORTERS_SQLITE_DB_FILE,
|
||||
'who=s' => \$WHO, 'emailTemplateFile=s' => \$EMAIL_TEMPLATE_FILE,
|
||||
'stampsComCsvFile=s' => \$stampsComCsvFile);
|
||||
sub UsageAndExit($) {
|
||||
print STDERR "usage: $0 --stampsComCsvFile=<PATH_TO_FILE> [ --supportersDB=PATH_TO_SUPPORTERS_SQLITE_DB_FILE --verbose=N ]\n";
|
||||
print STDERR "\n $_[0]\n";
|
||||
exit 2;
|
||||
}
|
||||
UsageAndExit("Cannot read supporters db file: $SUPPORTERS_SQLITE_DB_FILE") unless defined $SUPPORTERS_SQLITE_DB_FILE
|
||||
and -r $SUPPORTERS_SQLITE_DB_FILE;
|
||||
UsageAndExit("Cannot read email template: $EMAIL_TEMPLATE_FILE") unless defined $EMAIL_TEMPLATE_FILE
|
||||
and -r $EMAIL_TEMPLATE_FILE;
|
||||
UsageAndExit("--who is required") unless defined $WHO;
|
||||
UsageAndExit("Cannot read stampsComCsvFile: $stampsComCsvFile: $!") unless defined $stampsComCsvFile
|
||||
and -r $stampsComCsvFile and -f $stampsComCsvFile;
|
||||
|
||||
my($SUPPORTERS_SQLITE_DB_FILE, $T_SHIRT_TYPE, $WHO, $HOW, $TEX_FILE, $VERBOSE) = @ARGV;
|
||||
$VERBOSE = 0 if not defined $VERBOSE;
|
||||
|
||||
my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
|
||||
{ RaiseError => 1, sqlite_unicode => 1 })
|
||||
or die $DBI::errstr;
|
||||
|
||||
my $sp = new Supporters($dbh, [ "none" ]);
|
||||
# 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 %idsSent;
|
||||
open(TEX_FILE, "<", $TEX_FILE);
|
||||
# my $sp = new Supporters($dbh, $fh, { monthly => '^Conservancy:Supporters:Monthly',
|
||||
# annual => '^Conservancy:Supporters:(?:Annual|Match Pledge)' } );
|
||||
my $sp = new Supporters($dbh, [ '/bin/false' ]);
|
||||
|
||||
while (my $line = <TEX_FILE>) {
|
||||
if ($line =~ /Box.*\&\s*(\d+)\s*\&\s*(\S+)\s*\&\s*(\S+)\s*\&/) {
|
||||
my($id, $ledgerEntityId, $size) = ($1, $2, $3);
|
||||
die "id $id, and/or size $size not defined" unless defined $id and defined $size;
|
||||
$idsSent{$id}{$size} = 0 if not defined $idsSent{$id}{$size};
|
||||
$idsSent{$id}{$size}++;
|
||||
} else {
|
||||
print STDERR "skipping line $line" if ($VERBOSE >= 2);
|
||||
my @emailLines;
|
||||
open(my $emailFH, "<", $EMAIL_TEMPLATE_FILE);
|
||||
binmode $emailFH, ":utf8";
|
||||
@emailLines = <$emailFH>;
|
||||
close $emailFH;
|
||||
|
||||
open my $csvFH, "<:encoding(utf8)", $stampsComCsvFile;
|
||||
|
||||
my $csv = Text::CSV->new({ quote_char => '"', binary => 1, allow_whitespace => 1, quote_space=> 0,
|
||||
allow_loose_quotes => 1 });
|
||||
$csv->header($csvFH, { detect_bom => 1, munge_column_names => "lc" });
|
||||
|
||||
my %info;
|
||||
while (my $row = $csv->getline_hr($csvFH)) {
|
||||
$row->{'class service'} =~ s/\s*\(\s*R\s*\)\s*$//
|
||||
if (defined $row->{'class service'} and $row->{'class service'} !~ /^\s*$/);
|
||||
$row->{'tracking #'} =~ s/^\s*=\s*"([^"]+)"\s*$/$1/
|
||||
if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/);
|
||||
|
||||
die "no reference1" if (not defined $row->{reference1} );
|
||||
my(@vals) = split(',', $row->{reference1});
|
||||
my $id = shift @vals;
|
||||
$info{$id} = $row;
|
||||
|
||||
$info{$id}{shirts} = {}; $info{$id}{extras} = [];
|
||||
foreach my $item (@vals) {
|
||||
if ($item =~ /\s*\++\s*(\S.*)$/) {
|
||||
push(@{$info{$id}{extras}}, $1);
|
||||
next;
|
||||
}
|
||||
my($size, $type) = split(/_+/, $item);
|
||||
if ($type =~ /2018/) {
|
||||
$type = 't-shirt-fy2018design-0';
|
||||
} elsif ($type =~ /vint/i) {
|
||||
$type = 'vintage';
|
||||
} else {
|
||||
die "$type is not a known t-shirt type";
|
||||
}
|
||||
$info{$id}{shirts}{$type} = $size;
|
||||
}
|
||||
}
|
||||
|
||||
close TEX_FILE;
|
||||
foreach my $id (sort keys %info) {
|
||||
print "#" x 75;
|
||||
print "\n";
|
||||
print "Supporter $id:\n";
|
||||
foreach my $type (sort { $a cmp $b} keys %{$info{$id}{shirts}}) { print " Shirt: $type: $info{$id}{shirts}{$type}\n " }
|
||||
foreach my $extra (sort { $a cmp $b} @{$info{$id}{extras}}) { print " EXTRA: $extra\n " }
|
||||
|
||||
my $sentData = "";
|
||||
my $thisHow = "a package sent with stamp.com";
|
||||
my $service = "The package";
|
||||
my $delivered = 0;
|
||||
if (defined $info{$id}{'date delivered'} and $info{$id}{'date delivered'} !~ /^\s*$/) {
|
||||
if (defined $info{$id}{'class service'} and $info{$id}{'class service'} =~ /int\'l|international/i) {
|
||||
$service .= " left the USA sorting facility (bound for your country) on $info{$id}{'date delivered'}";
|
||||
} else {
|
||||
$service .= " was delivered on $info{$id}{'date delivered'}";
|
||||
$delivered = 1 if $info{$id}{'status'} and $info{$id}{'status'} =~ /eliver/i;
|
||||
}
|
||||
} else {
|
||||
$service .= " was shipped";
|
||||
$thisHow .= " shipped";
|
||||
if (defined $info{$id}{'ship date'} and $info{$id}{'ship date'} !~ /^\s*$/) {
|
||||
$service .= " on $info{$id}{'ship date'}";
|
||||
$thisHow .= " on $info{$id}{'ship date'}";
|
||||
}
|
||||
}
|
||||
$service .= " via $info{$id}{carrier}";
|
||||
$thisHow .= " with $info{$id}{carrier}";
|
||||
if (defined $info{$id}{'class service'} and $info{$id}{'class service'} !~ /^\s*$/) {
|
||||
$service .= "'s $info{$id}{'class service'}";
|
||||
$thisHow .= "'s $info{$id}{'class service'}";
|
||||
}
|
||||
if (defined $info{$id}{'tracking #'} and $info{$id}{'tracking #'} !~ /^\s*$/) {
|
||||
$service .= " with tracking number of $info{$id}{'tracking #'}";
|
||||
$thisHow .= " having a tracking number of $info{$id}{'tracking #'}";
|
||||
}
|
||||
$service .= ".";
|
||||
my $deliveryStatus = " The postal service has often been quite slow during the pandemic, so please be patient, but if the packge does not arrive within a few weeks, please contact us by replying to this email.";
|
||||
$deliveryStatus = "The postal service has confirmed delivery occurred, so please contact us *immediately* by replying to this email if the packge has not been received."
|
||||
if $delivered;
|
||||
|
||||
foreach my $id (sort keys %idsSent) {
|
||||
my @requestTypes = $sp->getRequestType();
|
||||
my $sizesSent;
|
||||
my $foundRequestCount = 0;
|
||||
my %need;
|
||||
foreach my $type (@requestTypes) {
|
||||
next unless ($type =~ /shirt/ and $type =~ /$T_SHIRT_TYPE/);
|
||||
my $request = $sp->getRequest({ donorId => $id, requestType => $type,
|
||||
ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
|
||||
if (defined $request and defined $request->{requestId} and defined $request->{requestType}) {
|
||||
$foundRequestCount++;
|
||||
my $size = $request->{requestConfiguration};
|
||||
if (not defined $idsSent{$id}{$size} and $idsSent{$id}{$size}-- > 0) {
|
||||
my $out = "WARNING: not fufilling $id request for $request->{requstConfiguration} because we sent wrong size of $idsSent{$id}!\n";
|
||||
print $out;
|
||||
print STDERR $out;
|
||||
$request = undef;
|
||||
} else {
|
||||
$sp->fulfillRequest({ donorId => $id, requestType => $request->{requestType},
|
||||
who => $WHO, how => $HOW});
|
||||
if (defined $sizesSent) {
|
||||
$sizesSent .= ", $size";
|
||||
} else {
|
||||
$sizesSent .= "$size";
|
||||
}
|
||||
$need{$type} = $request->{requestConfiguration} if $type =~ /^\s*t-shirt/;
|
||||
|
||||
}
|
||||
}
|
||||
my $cur = 't-shirt-fy2018design-0';
|
||||
if (defined $need{$cur} and defined $info{$id}{shirts}{$cur}) {
|
||||
die "$id: 2018design: $need{$cur} does not match defined $info{$id}{shirts}{$cur}"
|
||||
unless (($need{$cur} eq $info{$id}{shirts}{$cur}) or
|
||||
($need{$cur} eq 'FittedLadies2XL' and $info{$id}{shirts}{$cur} eq 'Ladies2XL'));
|
||||
my $size = $info{$id}{shirts}{$cur};
|
||||
$sp->fulfillRequest({ donorId => $id, requestType => $cur, who => $WHO, how => $thisHow});
|
||||
$sentData .= "A $size t-shirt in the 2018 design. ";
|
||||
delete $need{$cur};
|
||||
delete $info{$id}{shirts}{$cur};
|
||||
}
|
||||
# vintage type can fulfill other types
|
||||
foreach my $shirtType (keys %{$info{$id}{shirts}}) {
|
||||
my $size = $info{$id}{shirts}{$shirtType};
|
||||
foreach my $key (keys %need) {
|
||||
$need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/);
|
||||
if ($need{$key} eq $size) {
|
||||
$sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $thisHow});
|
||||
$sentData .= "A $size t-shirt in the vintage design. ";
|
||||
delete $need{$key};
|
||||
delete $info{$id}{shirts}{$shirtType};
|
||||
}
|
||||
}
|
||||
}
|
||||
unless ($foundRequestCount > 0) {
|
||||
my $out = "WARNING: We seem to have sent $id a t-shirt that $id didn't request! Ignoring that and contuining...\n";
|
||||
print $out;
|
||||
print STDERR $out;
|
||||
next;
|
||||
foreach my $shirtType (keys %{$info{$id}{shirts}}) {
|
||||
my $size = $info{$id}{shirts}{$shirtType};
|
||||
$sentData .= "A $size t-shirt in the $shirtType design that we included just becuase we thought you would like it. ";
|
||||
}
|
||||
foreach my $extra (sort { $a cmp $b} @{$info{$id}{extras}}) {
|
||||
if ($extra =~ /PIN/) {
|
||||
$sentData .= " A pin from our our CopyleftConf 2019! ";
|
||||
} else {
|
||||
die "Supporter $id: unkown extra: $extra";
|
||||
}
|
||||
}
|
||||
next unless $sp->emailOk($id);
|
||||
my %emails;
|
||||
my $email = $sp->getPreferredEmailAddress($id);
|
||||
if (defined $email) {
|
||||
|
|
@ -99,45 +223,28 @@ foreach my $id (sort keys %idsSent) {
|
|||
$line .= "<$email>";
|
||||
$fullEmailLine .= $line;
|
||||
}
|
||||
my $rtTicket = $sp->_getDonorField('rt_ticket', $id);
|
||||
$rtTicket = "" if not defined $rtTicket;
|
||||
$rtTicket = "[sfconservancy.org #$rtTicket]" if $rtTicket ne "";
|
||||
push(@emails, 'supporters@tix.sfconservancy.org') if $rtTicket ne "";
|
||||
open(my $sendmailFH, "|-", '/usr/sbin/sendmail', '-f', $FROM_ADDRESS, '-oi', '-oem', '--',
|
||||
@emails);
|
||||
binmode $sendmailFH, ":utf8";
|
||||
print $sendmailFH "To: $fullEmailLine\n";
|
||||
foreach my $line (@emailLines) {
|
||||
die "no displayname for this item" if not defined $displayName or $displayName =~ /^\s*$/;
|
||||
my $thisLine = $line; # Note: This is needed, apparently $line is by reference?
|
||||
$thisLine =~ s/FIXME_DISPLAYNAME/$displayName/g;
|
||||
$thisLine =~ s/FIXME_SUPPORTER_ID/$id/g;
|
||||
$thisLine =~ s/FIXME_SENT_INFO/$sentData/g;
|
||||
$thisLine =~ s/FIXME_DELVIERY_STATUS_INFO/$deliveryStatus/g;
|
||||
$thisLine =~ s/FIXME_RT_TICKET_DESCRIPTOR/$rtTicket/g;
|
||||
$thisLine =~ s/FIXME_POSTAL_SERVICE_INFO/$service/g;
|
||||
|
||||
my $fromAddress = 'supporters@tix.sfconservancy.org';
|
||||
my $pingNoGet = "";
|
||||
$pingNoGet = "\nPlease ping us if you do not receive your t-shirt within two weeks in the\nUSA, or three weeks outside of the USA.\n\n"
|
||||
if ($HOW =~ /post/);
|
||||
open(SENDMAIL, "|/usr/lib/sendmail -f \"$fromAddress\" -oi -oem -- $emailTo info\@sfconservancy.org") or
|
||||
die "unable to run sendmail: $!";
|
||||
print SENDMAIL <<DATA;
|
||||
To: $fullEmailLine
|
||||
From: "Software Freedom Conservancy" <$fromAddress>
|
||||
Subject: $sizesSent Conservancy T-Shirt was $HOW
|
||||
|
||||
[ We apologize if you get a duplicate of this notification. ]
|
||||
|
||||
According to our records, the t-shirt of size $sizesSent that you
|
||||
requested as a Conservancy Supporter was $HOW.
|
||||
$pingNoGet
|
||||
|
||||
Thank you again so much for supporting Conservancy.
|
||||
|
||||
We'd really appreciate if you'd post pictures of the shirt on social media
|
||||
and encourage others to sign up as a Conservancy supporter at
|
||||
https://sfconservancy.org/supporter/ . As you can see on that page, we are
|
||||
in the midst of our annual fundraising drive and seeking to reach a match
|
||||
donation. There's a unique opportunity remaining for just two more days for
|
||||
us to make a match donation.
|
||||
|
||||
So, encouraging others to sign up right now will make a huge difference!
|
||||
|
||||
Thank you again for your support of Conservancy.
|
||||
|
||||
Sincerely,
|
||||
--
|
||||
The Staff at Software Freedom Conservancy
|
||||
DATA
|
||||
close SENDMAIL;
|
||||
die "Unable to send email to $id: $!" unless $? == 0;
|
||||
|
||||
print STDERR "Emailed $emailTo for $id sending of $sizesSent size t-shirt and marked it fulfilled in database\n" if ($VERBOSE);
|
||||
print $sendmailFH $thisLine;
|
||||
}
|
||||
close $sendmailFH;
|
||||
usleep(70000);
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
|
|
|
|||
|
|
@ -8,81 +8,50 @@ 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;
|
||||
|
||||
my $LEDGER_CMD = "/usr/local/bin/ledger";
|
||||
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_COUNTS, $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, $OUTPUT_DIRECTORY, $MONTHLY_SEARCH_REGEX, $ANNUAL_SEARCH_REGEX, $VERBOSE, @LEDGER_CMD_LINE) = @ARGV;
|
||||
$VERBOSE = 0 if not defined $VERBOSE;
|
||||
|
||||
open(SIZE_COUNTS, "<", $SIZE_COUNTS);
|
||||
|
||||
my %sizeCounts;
|
||||
while (my $line = <SIZE_COUNTS>) {
|
||||
next if ($line =~ /^\s*#/ or $line =~ /^\s*$/);
|
||||
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}
|
||||
\\usepackage[T1]{fontenc}
|
||||
\\begin{document}
|
||||
\\vspace{-15in}
|
||||
|
||||
\\begin{tabular}{|l|l|l|l|l|} \\hline
|
||||
LIST_HEADER
|
||||
;
|
||||
|
||||
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 $sp = new Supporters($dbh, \@LEDGER_CMD_LINE, { monthly => $MONTHLY_SEARCH_REGEX, annual => $ANNUAL_SEARCH_REGEX});
|
||||
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;
|
||||
|
||||
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__};
|
||||
if ( (defined $type0 and $type0 =~ /month/i) or (defined $type1 and $type1 =~ /month/i)) {
|
||||
return ($_[0] <=> $_[1]);
|
||||
} else {
|
||||
return ($lastGaveDate0 cmp $lastGaveDate1);
|
||||
}
|
||||
}
|
||||
my @typeList;
|
||||
my @oldTypeList;
|
||||
if ($T_SHIRT_STYLE eq 'fy2018design') {
|
||||
@typeList = qw/t-shirt-fy2018design-0/;
|
||||
@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/;
|
||||
|
|
@ -93,110 +62,147 @@ if ($T_SHIRT_STYLE eq 'fy2018design') {
|
|||
die "Unknown t-shirt style given: $T_SHIRT_STYLE";
|
||||
}
|
||||
|
||||
foreach my $id (sort { sortFunction($a, $b); } @supporterIds) {
|
||||
my $sizeNeeded;
|
||||
foreach my $type (@typeList) {
|
||||
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}) {
|
||||
$sizeNeeded = $request->{requestConfiguration};
|
||||
last;
|
||||
$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;
|
||||
}
|
||||
}
|
||||
next if not defined $sizeNeeded; # If we don't need a size, we don't have a request.
|
||||
|
||||
my $shirtCount = 1; # Count 1 for the one we're about to send and...
|
||||
foreach my $oldType (@oldTypeList) {
|
||||
# ... cound each one off the old list
|
||||
$shirtCount++ if (defined $sp->getRequest({ donorId => $id, requestType => $oldType}));
|
||||
}
|
||||
my $amount = $sp->donorTotalGaveInPeriod(donorId => $id);
|
||||
if ($amount < ($GIVING_LIMIT * $shirtCount)) {
|
||||
print "Skipping $id request for $sizeNeeded because donor has requested $shirtCount shirts, only gave $amount and giving limit is $GIVING_LIMIT\n" if $VERBOSE;
|
||||
next;
|
||||
}
|
||||
|
||||
my $postalAddress = $sp->getPreferredPostalAddress($id);
|
||||
if (not defined $postalAddress) {
|
||||
my(@postalAddresses) = $sp->getPostalAddresses($id);
|
||||
$postalAddress = $postalAddresses[0];
|
||||
}
|
||||
my(@arrayPostal) = split("\n", $postalAddress);
|
||||
my $latexPostal = latex_encode($postalAddress);
|
||||
$latexPostal =~ s/\\unmatched\{0141\}/\L{}/g;
|
||||
$latexPostal =~ s/\\unmatched\{0142\}/\l{}/g;
|
||||
if ($latexPostal =~ /unmatched/) {
|
||||
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;
|
||||
next;
|
||||
}
|
||||
|
||||
{ no strict; no warnings; $sizeCounts{$sizeNeeded}--; }
|
||||
if ($sizeCounts{$sizeNeeded} < 0) {
|
||||
print STDERR "Skipping $id request for $sizeNeeded because we are out.\n" if $VERBOSE;
|
||||
next;
|
||||
}
|
||||
$overallCount++;
|
||||
$lines{$sizeNeeded}{labels} = "" unless defined $lines{$sizeNeeded}{labels};
|
||||
$lines{$sizeNeeded}{checklist} = [] unless defined $lines{$sizeNeeded}{checklist};
|
||||
$lines{$sizeNeeded}{addressList} = [] unless defined $lines{$sizeNeeded}{addressList};
|
||||
$lines{$sizeNeeded}{labels} .= '\mlabel{}{TO: \\\\ ' . join(' \\\\ ', split('\n', $latexPostal)) . "}\n";
|
||||
my $shortLatexPostal = latex_encode(sprintf('%-30.30s', join(" ", reverse split('\n', $postalAddress))));
|
||||
$shortLatexPostal =~ s/\\unmatched\{0141\}/\L{}/g;
|
||||
$shortLatexPostal =~ s/\\unmatched\{0142\}/\l{}/g;
|
||||
push(@{$lines{$sizeNeeded}{addressList}}, { id => $id, address => \@arrayPostal });
|
||||
push(@{$lines{$sizeNeeded}{checklist}}, '{ $\Box$} &' . sprintf("%-3d & %5s & %-30s & %s ",
|
||||
$id, encode('UTF-8', $sp->getLedgerEntityId($id)),
|
||||
encode('UTF-8', $sizeNeeded),
|
||||
$shortLatexPostal) .
|
||||
'\\\\ \hline' . "\n");
|
||||
}
|
||||
my $lineCount = 0;
|
||||
my @allAddresses;
|
||||
foreach my $size (sort { $a cmp $b } keys %lines) {
|
||||
foreach my $line (@{$lines{$size}{checklist}}) {
|
||||
if ($lineCount++ > 40) {
|
||||
$lineCount = 0;
|
||||
print LIST "\n\n", '\end{tabular}',"\n\\pagebreak\n\\begin{tabular}{|l|l|l|l|l|} \\hline\n";
|
||||
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;
|
||||
}
|
||||
print LIST $line;
|
||||
$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};
|
||||
}
|
||||
push(@allAddresses, @{$lines{$size}{addressList}});
|
||||
print LABELS $lines{$size}{labels};
|
||||
delete $lines{$size}{labels};
|
||||
delete $lines{$size}{addressList};
|
||||
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();
|
||||
|
||||
print LIST "\n\n", '\end{tabular}',"\n";
|
||||
print LIST "FINAL INVENTORY EXPECTED\n\\begin{tabular}{|l|l|} \\hline\n";
|
||||
print STDERR "Total Shirts: $overallCount\n" if $VERBOSE;
|
||||
|
||||
my %needList;
|
||||
foreach my $size (sort keys %sizeCounts) {
|
||||
if ($sizeCounts{$size} < 0) {
|
||||
$needList{$size} = abs($sizeCounts{$size});
|
||||
$sizeCounts{$size} = 0;
|
||||
}
|
||||
print LIST "$size & $sizeCounts{$size}\\\\\n";
|
||||
}
|
||||
my $overallNeed = 0;
|
||||
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";
|
||||
$overallNeed += $needList{$size};
|
||||
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 LIST "\\hline \n\n", '\end{tabular}',"\n\n\nOVERALL SENDING COUNT: $overallCount",
|
||||
"\n\nOVERAL NEED COUNT: $overallNeed\n", '\end{document}', "\n";
|
||||
close LIST;
|
||||
close LABELS;
|
||||
|
||||
open(my $yamlFH, '>', 'address.yml');
|
||||
use YAML::Tiny;
|
||||
my $yaml = YAML::Tiny->new(\@allAddresses);
|
||||
$yaml->write('address.yml');
|
||||
|
||||
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:
|
||||
|
|
|
|||
Loading…
Reference in a new issue