#!/usr/bin/perl use strict; use warnings; use autodie qw(:all); use Data::Dumper; 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 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(); 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= [ --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; $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 $fileName = BeancountQuerySubmit(< '^Conservancy:Supporters:Monthly', # annual => '^Conservancy:Supporters:(?:Annual|Match Pledge)' } ); my $sp = new Supporters($dbh, [ '/bin/false' ]); 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*$/); if ($row->{status} =~ /refund\s*pending/i and $row->{'refund status'} =~ /pending/i) { print STDERR "Refund pending for this item: ", Data::Dumper->Dump([$row]); next; } die "no reference1" if (not defined $row->{reference1} ); my $val = $row->{reference1}; die( "reference1 \"$row->{reference1}\" doesn't have an ID number on end, for shipment: " . Data::Dumper->Dump([$row])) unless $val =~ /^\s*(\S+)_(\d+)\s*$/; my($id, $shirt) = (int $2, $1); $info{$id}{shirts} = {} unless defined $info{$id}{shirts}; my($size, $type) = split(/_+/, $shirt); if ($type =~ /2018/) { $type = 't-shirt-fy2018design-0'; } elsif ($type =~ /vint/i) { $type = 't-shirt-vintage-0'; } elsif ($type =~ /2021/i) { $type = 't-shirt-fy2021design-0'; } elsif ($type =~ /2022/i) { $type = 't-shirt-cy2022design-0'; } else { die "$type is not a known t-shirt type"; } $info{$id}{shirts}{$type}{size} = $size; $info{$id}{shirts}{$type}{row} = $row; } my %DESIGN_NICKNAMES = ('t-shirt-fy2018design-0' => 2018, 't-shirt-fy2021design-0' => 2021, 't-shirt-cy2022design-0' => 2022, 't-shirt-vintage-0' => 'vintage'); if ($VERBOSE > 3) { use Data::Dumper; print STDERR Data::Dumper->Dump([\%info]); } foreach my $id (sort { $a <=> $b } 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}{size}\n " } foreach my $type (keys %{$info{$id}{shirts}}) { my $row = $info{$id}{shirts}{$type}{row}; my $size = $info{$id}{shirts}{$type}{size}; my $sentData = ""; my $thisHow = "a package sent with stamp.com"; my $service = "The package"; my $delivered = 0; if (defined $row->{'date delivered'} and $row->{'date delivered'} !~ /^\s*$/) { if (defined $row->{'class service'} and $row->{'class service'} =~ /int\'l|international/i) { $service .= " left the USA sorting facility (bound for your country) on $row->{'date delivered'}"; } else { $service .= " was delivered on $row->{'date delivered'}"; $delivered = 1 if $row->{'status'} and $row->{'status'} =~ /eliver/i and not $row->{'status'} =~ /undeliv/i; } } else { $service .= " was shipped"; $thisHow .= " shipped"; if (defined $row->{'ship date'} and $row->{'ship date'} !~ /^\s*$/) { $service .= " on $row->{'ship date'}"; $thisHow .= " on $row->{'ship date'}"; } } $service .= " via $row->{carrier}"; $thisHow .= " with $row->{carrier}"; if (defined $row->{'class service'} and $row->{'class service'} !~ /^\s*$/) { $service .= "'s $row->{'class service'}"; $thisHow .= "'s $row->{'class service'}"; } if (defined $row->{'tracking #'} and $row->{'tracking #'} !~ /^\s*$/) { $service .= " with tracking number of $row->{'tracking #'}"; $thisHow .= " having a tracking number of $row->{'tracking #'}"; } $service .= "."; my $deliveryStatus = " The postal service has often been quite slow during the pandemic, so please be patient, but if the package does not arrive within a few weeks, please contact us by replying to this email."; if (defined $row->{'status'} and $row->{'status'} =~ /undeliverable/i) { $deliveryStatus = " Unfortunately, the postal service has notified us that the package was \"$row->{'status'}\". We would appreciate if you'd reply to this email and tell us if you received the package, and possibly send us a new postal address so we can resend it!"; $thisHow .= " ; however, it was marked as \"$row->{'status'}\" by stamps.com"; } elsif (defined $row->{'status'} and $row->{'status'} =~ /rec.*action.*req/i) { $deliveryStatus = " Unfortunately, the postal service has notified us that the package was not yet delivered because \"$row->{'status'}\". We would appreciate if you'd reply to this email and tell us if you received the package!"; $thisHow .= " ; however, it was marked as \"$row->{'status'}\" by stamps.com"; } elsif ($delivered) { $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." } $info{$id}{shirts}{$type}{thisHow} = $thisHow; $sentData .= "A $size t-shirt in the $DESIGN_NICKNAMES{$type} design. "; my $sentSize = $size; my $sentType = "in the $DESIGN_NICKNAMES{$type} design"; my %emails; my $email = $sp->getPreferredEmailAddress($id); if (defined $email) { $emails{$email} = {}; } else { %emails = $sp->getEmailAddresses($id); } my(@emails) = keys(%emails); my $fullEmailLine = ""; my $emailTo = join(' ', @emails); my $displayName = $sp->getDisplayName($id); foreach my $email (@emails) { $fullEmailLine .= ", " if ($fullEmailLine ne ""); my $line = ""; if (defined $displayName) { $line .= $encoder->encode_phrase($displayName) . " "; } $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; $thisLine =~ s/FIXME_SENT_SIZE/$sentSize/g; $thisLine =~ s/FIXME_SENT_TYPE/$sentType/g; print $sendmailFH $thisLine; } close $sendmailFH; usleep(70000); } } foreach my $id (sort keys %info) { my @requestTypes = $sp->getRequestType(); my %need; foreach my $requestType (@requestTypes) { my $request = $sp->getRequest({ donorId => $id, requestType => $requestType, ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 }); if (defined $request and defined $request->{requestId} and defined $request->{requestType}) { $need{$request->{requestType}} = $request->{requestConfiguration} if $request->{requestType} =~ /^\s*t-shirt/; } } foreach my $type (keys %{$info{$id}{shirts}}) { my $size = $info{$id}{shirts}{$type}{size}; foreach my $key (keys %need) { $need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/); if ($need{$key} eq $size and $type eq $key) { $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}}); delete $need{$key}; delete $info{$id}{shirts}{$type}; } } } foreach my $type (keys %{$info{$id}{shirts}}) { my $size = $info{$id}{shirts}{$type}{size}; foreach my $key (keys %need) { $need{$key} = "Standard" . $need{$key} if ($need{$key} =~ /^Ladies/); if ($need{$key} eq $size and $key =~ /^t-shirt-(extra-)?[0123456789]/) { $sp->fulfillRequest({ donorId => $id, requestType => $key, who => $WHO, how => $info{$id}{shirts}{$type}{thisHow}}); delete $need{$key}; delete $info{$id}{shirts}{$type}; } } } foreach my $type (keys %{$info{$id}{shirts}}) { print "WARNING: For $id, shirt of $type in size $info{$id}{shirts}{$type}{size} did not fulfill a request\n"; } } ############################################################################### # # Local variables: # compile-command: "perl -c send-t-shirts.plx" # End: