2018-07-15 15:27:22 +00:00
#!/usr/bin/perl
# Copyright © 2018, Bradley M. Kuhn
# License: AGPL-3.0-or-later
use strict;
use warnings;
2018-07-22 23:02:13 +00:00
use autodie qw(:all);
2018-07-15 15:27:22 +00:00
use Getopt::Long;
use File::Spec;
use Date::Manip qw(ParseDate UnixDate);
2018-07-25 21:32:05 +00:00
our $RT_CMD;
2018-07-25 20:57:02 +00:00
require 'rt-helper.pl';
2018-07-25 21:32:05 +00:00
my($PAYMENT_DIR, $VERBOSE, $INTERACTIVE, $PAYMENT_NUMBER, $INVOICE_LINE, $INTERN_SUCCESS_FILE,
2018-07-25 16:40:19 +00:00
$INTERN_FAIL_FILE, $LEDGER_ENTRY_DATE, $SVN_CMD, $ROUND, $TRAVEL_NOTICE_TICKET);
2018-07-15 16:05:33 +00:00
2018-07-22 21:35:20 +00:00
###############################################################################
2018-07-15 16:05:58 +00:00
sub LedgerTagFromTicket($$) {
my($ticketSpec, $tag) = @_;
open(my $rtPayFH, "-|", "$RT_CMD", "show", "-f", 'CF.{ledger-tags}', $ticketSpec);
my $tagValue;
while (my $tagsLine = <$rtPayFH>) {
2018-07-22 22:13:03 +00:00
print STDERR "Tag Lookup for \"$ticketSpec\" for \"$tag\", searching this line for it: $tagsLine"
if ($VERBOSE > 6);
2018-07-15 16:05:58 +00:00
chomp $tagsLine;
2018-07-22 22:13:03 +00:00
if ($tagsLine =~ /^(?:\s*|\s*CF[^:]+\s*}\s*:\s*);?$tag\s*:\s*(.+)\s*$/i) {
2018-07-15 16:05:58 +00:00
$tagValue = $1;
last;
}
}
close $rtPayFH;
return $tagValue;
}
2018-07-22 21:35:20 +00:00
###############################################################################
2018-07-23 01:49:06 +00:00
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;
}
###############################################################################
2018-07-22 22:08:31 +00:00
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;
}
###############################################################################
2018-07-15 15:27:22 +00:00
2018-07-15 16:05:33 +00:00
GetOptions("paymentDir=s" => \$PAYMENT_DIR, "verbose=i" => \$VERBOSE, "interactive" => \$INTERACTIVE,
2018-07-22 22:08:31 +00:00
"paymentNumber=i" => \$PAYMENT_NUMBER, "rtCommand=s" => \$RT_CMD,
2018-07-22 23:35:55 +00:00
"invoiceLine=s" => \$INVOICE_LINE, "internSuccessFile=s", \$INTERN_SUCCESS_FILE,
2018-07-23 01:49:06 +00:00
"internFailFile=s", \$INTERN_FAIL_FILE, 'ledgerEntryDate=s' => \$LEDGER_ENTRY_DATE,
2018-07-25 16:40:19 +00:00
"svnCommand=s" => \$SVN_CMD, "round=s" => \$ROUND,
'travelNoticeTicket=i' => \$TRAVEL_NOTICE_TICKET);
2018-07-15 16:05:33 +00:00
$RT_CMD = '/usr/bin/rt' unless defined $RT_CMD;
2018-07-23 01:49:06 +00:00
$SVN_CMD = '/usr/bin/svn' unless defined $SVN_CMD;
2018-07-15 16:05:33 +00:00
$INTERACTIVE = 0 if not defined $INTERACTIVE;
2018-07-15 15:27:22 +00:00
2018-07-25 16:40:19 +00:00
unless (defined $TRAVEL_NOTICE_TICKET) {
print STDERR "usage: $0 --travelNoticeTicket=<TICKET_NUMBER> option is required and must be an integer\n";
exit 1;
}
2018-07-23 02:25:49 +00:00
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;
}
2018-07-23 01:49:06 +00:00
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;
}
2018-07-22 22:08:31 +00:00
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;
}
2018-07-15 15:27:22 +00:00
unless (defined $PAYMENT_DIR and -d $PAYMENT_DIR) {
print STDERR "usage: $0 --paymentDir=<DIRECTORY> option is required and directory must exist\n";
exit 1;
}
2018-07-22 23:35:55 +00:00
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;
}
my %internCorrespond = ('success' => [], 'failed' => [] );
open (my $internUpdateFH, "<", File::Spec->catfile($PAYMENT_DIR, $INTERN_SUCCESS_FILE));
while (my $line = <$internUpdateFH>) {
push(@{$internCorrespond{success}}, $line);
}
my @internFailData;
open (my $internFailFH, "<", File::Spec->catfile($PAYMENT_DIR, $INTERN_FAIL_FILE));
while (my $line = <$internFailFH>) {
push(@{$internCorrespond{failed}}, $line);
}
2018-07-22 22:09:13 +00:00
unless (defined $PAYMENT_NUMBER and $PAYMENT_NUMBER =~ /^[123]$/) {
2018-07-15 16:05:33 +00:00
print STDERR "usage: $0 --paymentNumber=<VALUE> option is required and must be 1, 2 or 3\n";
exit 1;
}
2018-07-15 15:27:22 +00:00
$VERBOSE = 0 unless defined $VERBOSE;
opendir(my $dh, $PAYMENT_DIR);
2018-07-22 22:31:18 +00:00
my $oldInterns = 0;
2018-07-15 15:27:22 +00:00
while (my $file = readdir $dh) {
unless ($file =~ /^\s*(success|faile?d?)-(\S+)\.txt\s*$/i) {
print STDERR "Skipping $file which does not match proper format...\n" if ($VERBOSE >= 2);
next;
}
my($pass, $name) = ($1, $2);
2018-07-15 16:04:31 +00:00
$pass = ($pass =~ /success/) ? 1 : 0;
2018-07-15 15:27:22 +00:00
open(my $fh, "<", File::Spec->catfile($PAYMENT_DIR, $file));
2018-07-15 16:04:31 +00:00
my $mentorDate;
2018-07-15 15:27:22 +00:00
while (my $line = <$fh> ) {
if ($line =~ /^\s*Date\s*:\s*(.+)\s*$/) {
2018-07-15 16:04:31 +00:00
$mentorDate = UnixDate(ParseDate($1), "%Y-%m-%d");
2018-07-15 15:27:22 +00:00
next;
}
}
2018-07-15 16:07:54 +00:00
if (not defined $mentorDate) {
print STDERR "\"$file\": Skipping: Inside that file there is no valid Date: header" ;
next;
}
2018-07-15 15:27:22 +00:00
my(@nameComponents) = split(/\s*-\s*/, $name);
my(@searchTerms);
foreach my $name (@nameComponents) {
push(@searchTerms, 'Subject LIKE "' . $name . '"');
}
2018-07-22 22:31:18 +00:00
# Find the ticket number for this intern.
2018-07-25 21:32:05 +00:00
my $ticket = Outreachy_FindUniqueTicket($ROUND, @searchTerms);
2018-07-15 15:27:22 +00:00
if (not defined $ticket) {
foreach my $term (@searchTerms) {
2018-09-23 00:28:45 +00:00
print STDERR "\"$file\": full search failed, trying \"$term\" by itself\n" if ($VERBOSE > 6);
$ticket = Outreachy_FindUniqueTicket($ROUND, ($term));
2018-07-15 15:27:22 +00:00
last if (defined $ticket);
}
}
2018-07-22 21:33:12 +00:00
if (not defined $ticket) {
if (not $INTERACTIVE) {
2018-07-23 01:49:06 +00:00
print STDERR "\"$file\": TICKET-NOT-FOUND: Skipped: unable to to find a matching ticket.\n";
2018-07-22 21:33:12 +00:00
next;
} else {
# FIXME: prompt for ticket
die "interactive mode not yet supported";
}
}
2018-07-22 22:31:18 +00:00
my $completedInternshipField = GetCustomFieldForTicket($ticket, "completed-internship");
if (not defined $completedInternshipField) {
2018-07-23 01:49:06 +00:00
print STDERR "\"$file\": \"$ticket\": FIELD-NOT-FOUND: Skipping: cannot determine Entity from ticket.\n" ;
2018-07-22 22:31:18 +00:00
next;
} elsif ($completedInternshipField eq 'successful') {
# Don't print to STDERR here, just keep a count since these are "old interns"
$oldInterns++;
next;
}
2018-07-22 22:08:45 +00:00
my $entity = LedgerTagFromTicket($ticket, 'Entity');
if (not defined $entity) {
2018-07-23 01:49:06 +00:00
print STDERR "\"$file\": \"$ticket\": ENTITY-NOT-FOUND: Skipping: cannot determine Entity from ticket.\n" ;
2018-07-22 22:08:45 +00:00
next;
}
if ($PAYMENT_NUMBER <= 1) {
2018-07-22 21:33:12 +00:00
print STDERR "Sorry, script does not yet support first payment\n";
exit 1;
}
# Check to see if this payment was already made
my $thisPayDate = PaymentDateByTicket($ticket, $PAYMENT_NUMBER);
if (defined $thisPayDate) {
2018-07-22 22:22:25 +00:00
print STDERR "\"$file\": \"$ticket\": Skipped: payment $PAYMENT_NUMBER",
" was already made on \"$thisPayDate\"";
2018-07-22 21:33:12 +00:00
if ($pass) {
print STDERR ".\n";
} else {
print STDERR "... BIG PROBLEM: the intern actually failed but got this payment.\n";
}
2018-07-22 22:08:59 +00:00
next;
2018-07-22 21:33:12 +00:00
}
# Check to see if previous payment was sent payment
2018-07-22 22:08:59 +00:00
my $prevPayNum = $PAYMENT_NUMBER - 1;
2018-07-22 21:33:12 +00:00
2018-07-22 22:08:59 +00:00
my $lastPayDate = PaymentDateByTicket($ticket, $prevPayNum);
2018-07-22 21:35:32 +00:00
if (not defined $lastPayDate) {
2018-07-22 22:08:59 +00:00
print STDERR "\"$file\": \"$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;
}
2018-07-22 23:02:07 +00:00
my $expectVal = 'payment-' . $PAYMENT_NUMBER . "-approved";
if ($completedInternshipField eq $expectVal) {
print STDERR "\"$file\": \"$ticket\": $PAYMENT_NUMBER PAYMENT-DONE: Skipped: completed-internship is ",
"\"$completedInternshipField\" which indicates this payment round is in process.\n";
next;
}
2018-07-22 23:36:07 +00:00
$expectVal = 'payment-' . $prevPayNum . "-approved";
2018-07-22 22:08:59 +00:00
if ($completedInternshipField ne $expectVal) {
print STDERR "\"$file\": \"$ticket\": Skipped: completed-internship field was ",
"\"$completedInternshipField\" instead of \"$expectVal\".\n";
next;
}
2018-08-06 02:15:51 +00:00
my(%links) = GetLinksForTicket($ticket);
2018-07-22 22:22:16 +00:00
if ($VERBOSE > 5) {
2018-08-07 17:29:25 +00:00
use Data::Dumper;
print STDERR "\"$file\": \"$ticket\": Found the following links: " , Data::Dumper->Dump([\%links]), "\n";
2018-07-22 22:22:16 +00:00
}
2018-08-07 17:29:25 +00:00
my $taxTicket = FindTaxTicketFromList(@{$links{DependsOn}});
2018-07-22 22:08:59 +00:00
if (not defined $taxTicket) {
print STDERR "\"$file\": \"$ticket\": Skipped: no tax ticket found.\n";
2018-07-22 22:22:16 +00:00
next;
2018-07-22 22:08:59 +00:00
}
2018-08-06 02:28:04 +00:00
my $reimbursementTicket = FindReimbursementTicketFromList($ROUND, @{$links{Members}});
2018-07-22 23:35:35 +00:00
if (not defined $reimbursementTicket) {
print STDERR "\"$file\": \"$ticket\": Skipped: no reimbursement ticket found.\n";
next;
}
2018-07-22 22:22:16 +00:00
print STDERR "\"$file\": \"$ticket\": found a tax ticket of \"$taxTicket\"\n" if ($VERBOSE > 5);
2018-07-22 22:08:59 +00:00
my $taxTicketStatus = GetStatusFromTicket($taxTicket);
if ($taxTicketStatus ne "resolved") {
2018-07-22 23:02:07 +00:00
print STDERR "\"$file\": \"$ticket\": TAX-TICKET-PENDING: \"$taxTicket\": Skipped: ",
2018-07-22 22:08:59 +00:00
"tax ticket is in status \"$taxTicketStatus\" instead of \"resolved\"\n";
next;
}
my $mainTicketStatus = GetStatusFromTicket($ticket);
if ($mainTicketStatus ne "needs-project-ok") {
2018-07-22 23:02:07 +00:00
print STDERR "\"$file\": \"$ticket\": PREV-PAYMENT-INCOMPLETE: Skipped: ",
2018-07-22 22:08:59 +00:00
"ticket is in status \"$mainTicketStatus\" instead of \"needs-project-ok\"\n";
2018-07-22 21:33:12 +00:00
next;
}
2018-07-23 01:49:06 +00:00
print STDERR "\"$file\": \"$ticket\": processing to payment $PAYMENT_NUMBER state... ";
my $successString = ($pass) ? "success" : "failed";
my $repositoryFile = File::Spec->catfile($PAYMENT_DIR, $mentorDate . "_" . $entity . '_' . $successString . '-report.mbox');
my $approvalTag = $repositoryFile;
$approvalTag =~ s%^.*(Projects/Outreachy/.*)$%$1%;
$approvalTag = " ;Approval: $approvalTag";
rename(File::Spec->catfile($PAYMENT_DIR, $file), $repositoryFile);
system($SVN_CMD, "add", $repositoryFile);
open(my $rtCorrespondFH, "|-", $RT_CMD, 'correspond', $ticket, '-m', '-');
my @dd;
foreach my $line (@{$internCorrespond{$successString}}) {
$line =~ s/FIXME_PAYMENT_NUMBER/$PAYMENT_NUMBER/g;
2018-07-23 01:53:50 +00:00
$line =~ s/FIXME_INVOICE_DATE/$LEDGER_ENTRY_DATE/g;
2018-07-23 01:49:06 +00:00
$line =~ s/FIXME_MENTOR_DATE/$mentorDate/g;
push(@dd, $line);
}
print $rtCorrespondFH @dd;
close $rtCorrespondFH;
my $invoiceTicket = $INVOICE_LINE;
$invoiceTicket =~ s%^.*ticket/(\d+).*$%$1%;
my $num = $ticket; $num =~ s%^.*ticket/(\d+).*$%$1%;
system($RT_CMD, 'link', $invoiceTicket, 'refersto', $num);
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 = ' $-500.00'; $rightA = ' $500.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);
open(my $ledgerEntryFH, ">>", File::Spec->catfile($PAYMENT_DIR, "entry.ledger"));
print $ledgerEntryFH <<LEDGER_ENTRY
2018-09-12 22:57:44 +00:00
$LEDGER_ENTRY_DATE FIXME - Outreachy Internship - Round 2018-05 - Payment $PAYMENT_NUMBER
2018-07-23 01:49:06 +00:00
@tags ;Invoice: $INVOICE_LINE
$approvalTag
Accrued:Accounts Payable:Outreachy $leftA
Expenses:Outreachy:Internships $rightA
LEDGER_ENTRY
;
close $ledgerEntryFH;
} else {
2018-07-25 16:40:19 +00:00
system($RT_CMD, "edit", $ticket, 'set', 'CF.{completed-internship}=unsuccessful');
2018-07-23 01:49:06 +00:00
if ($PAYMENT_NUMBER == 1) {
2018-07-25 16:40:19 +00:00
system($RT_CMD, "edit", $taxTicketStatus, 'set', 'Status=rejected');
system($RT_CMD, "edit", $ticket, 'set', 'Status=rejected');
2018-07-23 01:49:06 +00:00
} else {
2018-07-25 16:40:19 +00:00
system($RT_CMD, "edit", $ticket, 'set', 'Status=entered');
2018-07-23 01:49:06 +00:00
}
2018-09-12 22:57:53 +00:00
open(my $delTravelDependsFH, "-|", $RT_CMD, "link", '-d',
$reimbursementTicket, 'dependson', $TRAVEL_NOTICE_TICKET);
my $found;
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;
if (not defined $found) {
print STDERR "\"$file\": \"$ticket\": WARNING: unable to determin what to do about Travel ticket, $TRAVEL_NOTICE_TICKET... ";
} else {
# This means we already activiated this travel ticket, so we have to explain to the intern
open(my $travelTicketCorrespondFH, "|-", $RT_CMD, 'correspond', $reimbursementTicket, '-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";
print $rtCorrespondFH @dd;
close $rtCorrespondFH;
}
2018-07-25 16:40:19 +00:00
system($RT_CMD, "edit", $reimbursementTicket, 'set', 'Status=open');
system($RT_CMD, "edit", $reimbursementTicket, 'set', 'Status=rejected');
2018-07-23 01:49:06 +00:00
}
print STDERR "...done\n";
print STDERR "Waiting? ";
my $x = <STDIN>;
2018-07-15 15:27:22 +00:00
}
2018-07-22 22:31:18 +00:00
print STDERR "Old Interns, who were marked as successful (likely from previous interns) ignored: $oldInterns\n";
2018-07-15 15:34:14 +00:00
###############################################################################
#
# Local variables:
# compile-command: "perl -c rt-outreachy-payment-next.plx"
# perl-indent-level: 2
# End: