RT-Client-Tools/scripts/rt-outreachy-payment-next.plx
Bradley M. Kuhn e5bf1e9f90 Approvals no longer in files, but in the ticket comments.
This script was originally written to handle the approval data appearing in
files in a directory rather than the ticket traffic itself.  This change
reworks that so that the script is always processing a group of tickets, and
searches for payment approval in the ticket traffic itself.

Note that this change is not yet secure, as the interns, if they know format,
could "approve themselves".  The "security" comes from the script before (or
a by hand action with someone with RT access to set the completed-internship
field to 'payment-N-approved'.
2019-02-28 16:22:07 -08:00

487 lines
19 KiB
Perl
Executable file

#!/usr/bin/perl
# Copyright © 2018, Bradley M. Kuhn
# License: AGPL-3.0-or-later
use strict;
use warnings;
use autodie qw(:all);
use Getopt::Long;
use File::Spec;
use Date::Manip qw(ParseDate UnixDate);
our $RT_CMD;
require 'rt-helper.pl';
our $VERBOSE;
my($PAYMENT_DIR, $INTERACTIVE, $PAYMENT_NUMBER, $INVOICE_LINE, $INTERN_SUCCESS_FILE,
$INTERN_FAIL_FILE, $LEDGER_ENTRY_DATE, $SVN_CMD, $ROUND, $TRAVEL_NOTICE_TICKET,
$OVERRIDE_APPROVAL_TAG, $TRAVEL_ACTIVATE_FILE);
my %TRAVEL_TICKET_DUE = ('2018-12' => 'Due=2020-12-03 00:00:00');
###############################################################################
sub LedgerTagFromTicket($$) {
my($ticketSpec, $tag) = @_;
open(my $rtPayFH, "-|", "$RT_CMD", "show", "-f", 'CF.{ledger-tags}', $ticketSpec);
my $tagValue;
while (my $tagsLine = <$rtPayFH>) {
print STDERR "Tag Lookup for \"$ticketSpec\" for \"$tag\", searching this line for it: $tagsLine"
if ($VERBOSE > 6);
chomp $tagsLine;
if ($tagsLine =~ /^(?:\s*|\s*CF[^:]+\s*}\s*:\s*);?$tag\s*:\s*(.+)\s*$/i) {
$tagValue = $1;
last;
}
}
close $rtPayFH;
return $tagValue;
}
###############################################################################
sub AllFormattedLedgerTagFromTicket($) {
my($ticketSpec) = @_;
my @tags;
open(my $rtLedgerTagsFH, "-|", "$RT_CMD", "show", "-f", 'CF.{ledger-tags}', $ticketSpec);
my $tagValue;
my $start = 0;
while (my $tagsLine = <$rtLedgerTagsFH>) {
$start = 1 if $tagsLine =~ s/^\s*CF.{ledger-tags}\s*:\s+//;
next unless $start;
$tagsLine =~ s/^\s*//;
push(@tags, " $tagsLine");
}
close $rtLedgerTagsFH;
return @tags;
}
###############################################################################
sub FindTaxTicketFromList(@) {
my $taxTicket;
foreach my $ticket (@_) {
open(my $rtQueueFH, "-|", "$RT_CMD", "show", "-f", 'Queue', $ticket);
while (my $queueLine = <$rtQueueFH>) {
if ($queueLine =~ /\s*Queue\s*:\s*(\S+)\s*$/) {
my $queue = $1;
$taxTicket = $ticket if $queue =~ /accounts-taxinfo/;
last;
}
}
close $rtQueueFH;
last if defined $taxTicket;
}
return $taxTicket;
}
###############################################################################
sub FindTravelTicketFromList(@) {
my $travelTicket;
my @possibles;
foreach my $ticket (@_) {
open(my $rtQueueFH, "-|", "$RT_CMD", "show", "-f", 'Queue', $ticket);
while (my $queueLine = <$rtQueueFH>) {
if ($queueLine =~ /\s*Queue\s*:\s*(\S+)\s*$/) {
my $queue = $1;
push(@possibles, $ticket) if $queue =~ /accounts-payable/;
}
}
close $rtQueueFH;
}
foreach my $ticket (@possibles) {
open(my $rtSubjectFH, "-|", "$RT_CMD", "show", "-f", 'Subject', $ticket);
while (my $subLine = <$rtSubjectFH>) {
if ($subLine =~ /\s*Subject\s*:\s*(.+)\s*$/) {
my $subject = $1;
$travelTicket = $ticket if $subject =~ /travel/i;
last;
}
}
close $rtSubjectFH;
}
return $travelTicket;
}
###############################################################################
sub TravelTicketDeLink($$) {
my ($travelNoticeTicket, $travelTicket) = @_;
my $found;
open(my $delTravelDependsFH, "-|", $RT_CMD, "link", '-d',
$travelTicket, 'dependson', $travelNoticeTicket);
while (my $line = <$delTravelDependsFH>) {
if ($line =~ /Link\s+not\s+found/i) {
$found = 0;
} elsif ($line =~ /no\s+longer\s+depends\s+on\s+Ticket/i) {
$found = 1;
}
last if defined $found;
}
close $delTravelDependsFH;
return $found
}
###############################################################################
GetOptions("paymentDir=s" => \$PAYMENT_DIR, "verbose=i" => \$VERBOSE, "interactive" => \$INTERACTIVE,
"paymentNumber=i" => \$PAYMENT_NUMBER, "rtCommand=s" => \$RT_CMD,
"invoiceLine=s" => \$INVOICE_LINE, "internSuccessFile=s", \$INTERN_SUCCESS_FILE,
"internFailFile=s", \$INTERN_FAIL_FILE, 'ledgerEntryDate=s' => \$LEDGER_ENTRY_DATE,
"svnCommand=s" => \$SVN_CMD, "round=s" => \$ROUND,
'overrideApprovalTag=s' => \$OVERRIDE_APPROVAL_TAG, 'travelActivateFile=s' => \$TRAVEL_ACTIVATE_FILE,
'travelNoticeTicket=i' => \$TRAVEL_NOTICE_TICKET);
$RT_CMD = '/usr/bin/rt' unless defined $RT_CMD;
$SVN_CMD = '/usr/bin/svn' unless defined $SVN_CMD;
$INTERACTIVE = 0 if not defined $INTERACTIVE;
unless (defined $TRAVEL_NOTICE_TICKET) {
print STDERR "usage: $0 --travelNoticeTicket=<TICKET_NUMBER> option is required and must be an integer\n";
exit 1;
}
unless (defined $ROUND and $ROUND =~ /^[\d\-]+$/) {
print STDERR "usage: $0 --round=<YEAR-MONTH> option is required and must formated as YYYY-MM\n";
exit 1;
}
unless (defined $TRAVEL_TICKET_DUE{$ROUND}) {
print STDERR "usage: $0 --round=<YEAR-MONTH> option must be a round that this script knows the deadlines for, but it doesn't\n";
exit 1;
}
unless (defined $LEDGER_ENTRY_DATE and $LEDGER_ENTRY_DATE =~ /^[\d\-]+$/) {
print STDERR "usage: $0 --ledgerEntryDate=<DATE> option is required and must be in ISO 8601 format\n";
exit 1;
}
unless (defined $INVOICE_LINE and $INVOICE_LINE =~ /^rt.*/) {
print STDERR "usage: $0 --invoiceLine=<RT_SPEC> option is required and must match an RT spec\n";
exit 1;
}
unless (defined $PAYMENT_DIR and -d $PAYMENT_DIR) {
print STDERR "usage: $0 --paymentDir=<DIRECTORY> option is required and directory must exist\n";
exit 1;
}
unless (-r $INTERN_SUCCESS_FILE and -f $INTERN_SUCCESS_FILE) {
print STDERR "usage: $0 --internUpdateFile=<FILE> option is required and must be readible text file\n";
exit 1;
}
unless (-r $INTERN_FAIL_FILE and -f $INTERN_FAIL_FILE) {
print STDERR "usage: $0 --internFailFile=<FILE> option is required and must be readible text file\n";
exit 1;
}
unless (defined $PAYMENT_NUMBER and $PAYMENT_NUMBER =~ /^[123]$/) {
print STDERR "usage: $0 --paymentNumber=<VALUE> option is required and must be 1, 2 or 3\n";
exit 1;
}
if ( (not defined $OVERRIDE_APPROVAL_TAG) and $PAYMENT_NUMBER == 1) {
print STDERR "usage: $0 --overrideApprovalTag=<STRING> option is required if payment number is 1\n";
exit 1;
}
unless (defined $TRAVEL_ACTIVATE_FILE or $PAYMENT_NUMBER != 1) {
print STDERR "usage: $0 --travelActivateFile=<TEXT_FILE> option is required and must be an file in $PAYMENT_DIR\n";
exit 1;
}
my %internCorrespond = ('success' => [], 'failed' => [], 'travel' => [] );
open (my $internUpdateFH, "<", File::Spec->catfile($PAYMENT_DIR, $INTERN_SUCCESS_FILE));
while (my $line = <$internUpdateFH>) {
push(@{$internCorrespond{success}}, $line);
}
open (my $internFailFH, "<", File::Spec->catfile($PAYMENT_DIR, $INTERN_FAIL_FILE));
while (my $line = <$internFailFH>) {
push(@{$internCorrespond{failed}}, $line);
}
if (defined $TRAVEL_ACTIVATE_FILE) {
open (my $travelActiveFH, "<", File::Spec->catfile($PAYMENT_DIR, $TRAVEL_ACTIVATE_FILE));
while (my $line = <$travelActiveFH>) {
push(@{$internCorrespond{travel}}, $line);
}
}
$VERBOSE = 0 unless defined $VERBOSE;
my $oldInterns = 0;
my(@processList);
if (@ARGV > 0) {
foreach my $ticket (@ARGV) {
if ($ticket =~ /^\d+$/) {
$ticket = "ticket/$ticket";
}
unless ($ticket =~ /^ticket\/\d+$/) {
print STDERR "Invalid ticket number on command line: $ticket\n";
exit 1;
}
push(@processList, $ticket);
}
} else {
open(my $rtLsFH, "-|", "$RT_CMD", "ls", "-i", 'Queue = outreachy-interns ' .
"AND Subject LIKE '" . $ROUND . "' AND status = 'needs-project-ok'");
while (my $lsLine = <$rtLsFH>) {
chomp $lsLine;
if ($lsLine =~ /ticket/) {
push(@processList, $lsLine);
}
}
close $rtLsFH;
}
foreach my $ticket (@processList) {
my(%paymentVals, $pass, $mentorDate, $approvalTag);
if ($PAYMENT_NUMBER == 1) {
$pass = 1;
$mentorDate = $LEDGER_ENTRY_DATE;
$approvalTag = " ;Approval: $OVERRIDE_APPROVAL_TAG";
}
my $ticketNum = $ticket; $ticketNum =~ s%^.*ticket/(\d+).*$%$1%;
open(my $logFH, "-|", $RT_CMD, "show", $ticketNum);
while (my $line = <$logFH>) {
if ($line =~ /^\s*([^:]+)\s*:\s*(.+)$/) {
my($key, $val) = ($1, $2);
# Note that this will take the last one used, since rt log gives ticket traffic IN ORDER.
$paymentVals{$key} = $val if $key =~ /(CONTRACTED NAME|PAYMENT NAME|PAYMENT METHOD)/i;
print STDERR "\"$ticket\": rt show $ticketNum line match: $key $val for $line" if ($VERBOSE > 7);
} elsif ($PAYMENT_NUMBER != 1 and (not defined $pass) and $line =~ /^\s*Payment\s+approved\s+by/) {
$pass = 1;
$line = <$logFH>;
unless ($line =~ /^\s*on([\d:\+\.\-\s]+)\s+from/) {
print STDERR "\"$ticket\": Skipping: Found Payment approved but there is no proper date field.";
next;
}
$mentorDate = UnixDate(ParseDate($1), "%Y-%m-%d");
next unless defined $mentorDate;
my $attachmentNum;
while (my $subLine = <$logFH>) {
last if $subLine =~ /^\=\=\=\>\s+/;
if ($subLine =~ /^\s+(\d+)\s+\:/) {
$attachmentNum = $1;
last;
}
}
$approvalTag = " ;Approval: rt://ticket/${ticketNum}/attachments/";
}
}
close $logFH;
if (not defined $pass) {
print STDERR "\"$ticket\": Skipping: pass/fail information not found" ;
next;
}
if ($pass and not defined $mentorDate) {
print STDERR "\"$ticket\": Skipping: there was a pass here for this payment, but unable to find mentor evaluation date for that pass." ;
next;
}
my $completedInternshipField = GetCustomFieldForTicket($ticket, "completed-internship");
if (not defined $completedInternshipField) {
print STDERR "\"$ticket\": FIELD-NOT-FOUND: Skipping: cannot determine Entity from ticket.\n" ;
next;
} elsif ($completedInternshipField eq 'successful') {
# Don't print to STDERR here, just keep a count since these are "old interns"
$oldInterns++;
next;
}
my $entity = LedgerTagFromTicket($ticket, 'Entity');
if (not defined $entity) {
print STDERR "\"$ticket\": ENTITY-NOT-FOUND: Skipping: cannot determine Entity from ticket.\n" ;
next;
}
if ($PAYMENT_NUMBER < 1 or $PAYMENT_NUMBER > 3) {
print STDERR "Payment number should be between 1 and 3\n";
exit 1;
}
# Check to see if this payment was already made
my $thisPayDate = PaymentDateByTicket($ticket, $PAYMENT_NUMBER);
if (defined $thisPayDate) {
print STDERR "\"$ticket\": Skipped: payment $PAYMENT_NUMBER",
" was already made on \"$thisPayDate\"";
if ($pass) {
print STDERR ".\n";
} else {
print STDERR "... BIG PROBLEM: the intern actually failed but got this payment.\n";
}
next;
}
# Check to see if previous payment was sent payment
my $prevPayNum = $PAYMENT_NUMBER - 1;
if ($prevPayNum > 0) {
my $lastPayDate = PaymentDateByTicket($ticket, $prevPayNum);
if (not defined $lastPayDate) {
print STDERR "\"$ticket\": Skipped: payment $prevPayNum was not made yet";
if ($pass) {
print STDERR ".\n";
} else {
print STDERR "... NOTE: previous payment was not sent; should it be sent now?\n";
}
next;
}
}
my $expectVal = 'payment-' . $PAYMENT_NUMBER . "-approved";
if ($completedInternshipField eq $expectVal and $PAYMENT_NUMBER != 1) {
print STDERR "\"$ticket\": $PAYMENT_NUMBER PAYMENT-DONE: Skipped: completed-internship is ",
"\"$completedInternshipField\" which indicates this payment round is in process.\n";
next;
}
$expectVal = 'payment-' . $prevPayNum . "-approved" if $PAYMENT_NUMBER != 1;
if ($prevPayNum > 0 and $completedInternshipField ne $expectVal) {
print STDERR "\"$ticket\": Skipped: completed-internship field was ",
"\"$completedInternshipField\" instead of \"$expectVal\".\n";
next;
}
my(%links) = GetLinksForTicket($ticket);
if ($VERBOSE > 5) {
use Data::Dumper;
print STDERR "\"$ticket\": Found the following links: " , Data::Dumper->Dump([\%links]), "\n";
}
my $taxTicket = FindTaxTicketFromList(@{$links{DependsOn}});
if (not defined $taxTicket) {
print STDERR "\"$ticket\": Skipped: no tax ticket found.\n";
next;
}
my $reimbursementTicket = FindReimbursementTicketFromList($ROUND, @{$links{Members}});
if (not defined $reimbursementTicket) {
print STDERR "\"$ticket\": Skipped: no reimbursement ticket found.\n";
next;
}
print STDERR "\"$ticket\": found a tax ticket of \"$taxTicket\"\n" if ($VERBOSE > 5);
my $taxTicketStatus = GetStatusFromTicket($taxTicket);
if ($taxTicketStatus ne "resolved") {
print STDERR "\"$ticket\": TAX-TICKET-PENDING: \"$taxTicket\": Skipped: ",
"tax ticket is in status \"$taxTicketStatus\" instead of \"resolved\"\n";
next;
}
my $mainTicketStatus = GetStatusFromTicket($ticket);
if ($mainTicketStatus ne "needs-project-ok") {
print STDERR "\"$ticket\": PREV-PAYMENT-INCOMPLETE: Skipped: ",
"ticket is in status \"$mainTicketStatus\" instead of \"needs-project-ok\"\n";
next;
}
print STDERR "\"$ticket\": processing to payment $PAYMENT_NUMBER state... ";
my $successString = ($pass) ? "success" : "failed";
open(my $rtCorrespondFH, "|-", $RT_CMD, 'correspond', $ticket, '-m', '-');
my @dd;
foreach my $line (@{$internCorrespond{$successString}}) {
$line =~ s/FIXME_PAYMENT_NUMBER/$PAYMENT_NUMBER/g;
$line =~ s/FIXME_INVOICE_DATE/$LEDGER_ENTRY_DATE/g;
$line =~ s/FIXME_MENTOR_DATE/$mentorDate/g;
push(@dd, $line);
}
print $rtCorrespondFH @dd;
close $rtCorrespondFH;
my $invoiceTicket = $INVOICE_LINE;
$invoiceTicket =~ s%^.*ticket/(\d+).*$%$1%;
system($RT_CMD, 'link', $invoiceTicket, 'refersto', $ticketNum);
if ($pass) {
open(my $rtCommentFH, "|-", $RT_CMD, 'comment', $ticket, '-m', '-');
print $rtCommentFH " ;Invoice: $INVOICE_LINE\n";
close $rtCommentFH;
system($RT_CMD, "edit", $ticket, 'set', 'CF.{completed-internship}=payment-' . $PAYMENT_NUMBER . '-approved',
'Status=open');
my($leftA, $rightA);
if ($PAYMENT_NUMBER == 1) {
$leftA = ' $-1,000.00'; $rightA = ' $1,000.00';
} elsif ($PAYMENT_NUMBER == 2) {
$leftA = '$-2,250.00'; $rightA = '$2,250.00';
} elsif ($PAYMENT_NUMBER == 3) {
$leftA = '$-2,750.00'; $rightA = '$2,750.00';
}
my(@tags) = AllFormattedLedgerTagFromTicket($ticket);
my $contractName = 'FIXME';
$contractName = $paymentVals{'CONTRACTED NAME'} if defined $paymentVals{'CONTRACTED NAME'};
$contractName =~ s/^\s*//; $contractName =~ s/\s*$//;
open(my $paymentValsFH, ">", File::Spec->catfile($PAYMENT_DIR, "payment-values.txt"));
print $paymentValsFH "OUTREACHY INTERNSHIP PAYMENT $PAYMENT_NUMBER\n";
foreach my $key (keys %paymentVals) {
print $paymentValsFH sprintf(" %20s: ", $key), "$paymentVals{$key}\n";
}
print $paymentValsFH sprintf(" %20s", 'TOTAL AMOUNT'), "$rightA\n\n LEDGER ENTRY:\n";
my $ledgerEntryFile = File::Spec->catfile($PAYMENT_DIR, "entry.ledger");
open(my $ledgerEntryFH, ">>", $ledgerEntryFile);
my $ledgerEntryStr = <<LEDGER_ENTRY
$LEDGER_ENTRY_DATE $contractName - Outreachy Internship - Round 2018-12 - Payment $PAYMENT_NUMBER
@tags ;Invoice: $INVOICE_LINE
$approvalTag
Accrued:Accounts Payable:Outreachy $leftA
Expenses:Outreachy:Internships $rightA
LEDGER_ENTRY
;
print $ledgerEntryFH $ledgerEntryStr;
close $ledgerEntryFH ;
open(my $ledgerTagConvertFH, "-|", join(" ", File::Spec->catfile($ENV{CONSERVANCY_REPOSITORY},
'Financial', 'Code', 'ledger-tag-convert.plx') .
'<' . $ledgerEntryFile));
foreach my $line (<$ledgerTagConvertFH>) {
print $paymentValsFH " ", $line;
}
close $ledgerTagConvertFH;
close $paymentValsFH;
# ACTIVATE TRAVEL TICKET AFTER PAYMENT 1
if ($PAYMENT_NUMBER == 1) {
my $travelTicketSpec = FindTravelTicketFromList(@{$links{Members}});
my $travelTicketNum = $travelTicketSpec;
$travelTicketNum =~ s%^.*ticket/(\d+).*$%$1%;
my $travelTicketStatus = GetStatusFromTicket($travelTicketNum);
if ( (not defined $travelTicketSpec) or $travelTicketStatus ne 'needs-project-ok') {
print STDERR "\"$ticket\": Travel Ticket: \"$travelTicketSpec\": unable to open travel ticket which is in status \"$travelTicketStatus\"\n";
goto NEXT_TICKET;
}
my $found = TravelTicketDeLink($TRAVEL_NOTICE_TICKET, $travelTicketNum);
if ((not defined $found) or (not $found)) {
print STDERR "\"$ticket\": WARNING: unable to open travel ticket, $travelTicketNum, as it is not linked to $TRAVEL_NOTICE_TICKET... ";
goto NEXT_TICKET;
}
open(my $travelTicketCorrespondFH, "|-", $RT_CMD, 'correspond', $travelTicketNum, '-m', '-');
my @dd;
foreach my $line (@{$internCorrespond{travel}}) {
$line =~ s/FIXME_PAYMENT_NUMBER/$PAYMENT_NUMBER/g;
$line =~ s/FIXME_INVOICE_DATE/$LEDGER_ENTRY_DATE/g;
$line =~ s/FIXME_MENTOR_DATE/$mentorDate/g;
push(@dd, $line);
}
print $travelTicketCorrespondFH @dd;
close $travelTicketCorrespondFH;
system($RT_CMD, "edit", $travelTicketNum, 'set', 'CF.{due-date-from}=budget-expiration', $TRAVEL_TICKET_DUE{$ROUND},
'Status=awaiting-request');
}
} else {
system($RT_CMD, "edit", $ticket, 'set', 'CF.{completed-internship}=unsuccessful');
if ($PAYMENT_NUMBER == 1) {
system($RT_CMD, "edit", $taxTicketStatus, 'set', 'Status=rejected');
system($RT_CMD, "edit", $ticket, 'set', 'Status=rejected');
} else {
system($RT_CMD, "edit", $ticket, 'set', 'Status=entered');
}
my $travelTicketSpec = FindTravelTicketFromList(@{$links{Members}});
my $travelTicketNum = $travelTicketSpec;
my $found = TravelTicketDeLink($TRAVEL_NOTICE_TICKET, $travelTicketNum);
if (not defined $found) {
print STDERR "\"$ticket\": WARNING: unable to determine what to do about Travel ticket, $travelTicketNum, as it is not linked to $TRAVEL_NOTICE_TICKET... ";
} elsif (not $found) {
# This means we already activiated this travel ticket, so we have to explain to the intern
open(my $travelTicketCorrespondFH, "|-", $RT_CMD, 'correspond', $travelTicketNum, '-m', '-');
print $rtCorrespondFH "Previously, you received notice about your travel stipend. Please be advised that due to your failure in your internship, you no longer have a travel stipend budget.\n\n";
close $rtCorrespondFH;
}
system($RT_CMD, "edit", $reimbursementTicket, 'set', 'Status=open');
system($RT_CMD, "edit", $reimbursementTicket, 'set', 'Status=rejected');
system($RT_CMD, "edit", $travelTicketNum, 'set', 'Status=rejected');
}
NEXT_TICKET:
print STDERR "...done\n";
print STDERR "Waiting? ";
my $x = <STDIN>;
}
print STDERR "Old Interns, who were marked as successful (likely from previous interns) ignored: $oldInterns\n";
###############################################################################
#
# Local variables:
# compile-command: "perl -c rt-outreachy-payment-next.plx"
# perl-indent-level: 2
# End: