329 lines
11 KiB
Perl
Executable file
329 lines
11 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);
|
|
|
|
my($PAYMENT_DIR, $VERBOSE, $INTERACTIVE, $PAYMENT_NUMBER, $RT_CMD, $INVOICE_LINE, $INTERN_SUCCESS_FILE,
|
|
$INTERN_FAIL_FILE);
|
|
|
|
###############################################################################
|
|
sub FindUniqueTicket(@) {
|
|
my @searchTerms = @_;
|
|
open(my $rtLsFH, "-|", "$RT_CMD", "ls", "-i", 'Queue = outreachy-interns AND ' .
|
|
join(" AND ", @searchTerms));
|
|
my $ticketSpec;
|
|
while (my $lsLine = <$rtLsFH>) {
|
|
chomp $lsLine;
|
|
if ($lsLine =~ /ticket/) {
|
|
if (defined $ticketSpec) {
|
|
$ticketSpec = undef;
|
|
last;
|
|
}
|
|
$ticketSpec = $lsLine;
|
|
}
|
|
}
|
|
close $rtLsFH;
|
|
return $ticketSpec;
|
|
}
|
|
###############################################################################
|
|
sub PaymentDateByTicket($$) {
|
|
my($ticketSpec, $paymentNumber) = @_;
|
|
open(my $rtPayFH, "-|", "$RT_CMD", "show", "-f", 'CF.{payment-' . $paymentNumber . '-sent}', $ticketSpec);
|
|
my $date;
|
|
while (my $payLine = <$rtPayFH>) {
|
|
chomp $payLine;
|
|
if ($payLine =~ /^\s*CF\s*.\s*{payment-$paymentNumber-sent}\s*:\s*[\d\-]+\s*$/) {
|
|
$date = $payLine;
|
|
last;
|
|
}
|
|
}
|
|
close $rtPayFH;
|
|
return $date;
|
|
}
|
|
###############################################################################
|
|
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 GetLinksForTicket($) {
|
|
my($ticketSpec) = @_;
|
|
my @linked;
|
|
open(my $rtLinksFH, "-|", "$RT_CMD", "show", $ticketSpec . '/links');
|
|
while (my $linksLine = <$rtLinksFH>) {
|
|
if ($linksLine =~ m%rt.*(ticket/\d+)\s*,?\s*$%) {
|
|
push(@linked, $1);
|
|
}
|
|
}
|
|
close $rtLinksFH;
|
|
return @linked;
|
|
}
|
|
###############################################################################
|
|
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 FindReimbursementTicketFromList(@) {
|
|
my $reimbursementTicket;
|
|
foreach my $ticket (@_) {
|
|
$ticket =~ s%\s*ticket/?\s*(\d+)\s*%$1%;
|
|
open(my $rtReimburseFH, "-|", "$RT_CMD", "ls", "-i", 'Queue = accounts-payable AND ' .
|
|
"Subject LIKE 'reimbursement' and Subject LIKE 'travel' and id = " . $ticket);
|
|
while (my $reimburseLine = <$rtReimburseFH>) {
|
|
if ($reimburseLine =~ m%\s*ticket\s*/?\s*(\d+)\s*$%) {
|
|
my $tt = $1;
|
|
if ($tt == $ticket) {
|
|
$reimbursementTicket = $ticket;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
close $rtReimburseFH;
|
|
last if defined $reimbursementTicket;
|
|
}
|
|
return $reimbursementTicket;
|
|
}
|
|
###############################################################################
|
|
sub GetStatusFromTicket($) {
|
|
my($ticketSpec) = @_;
|
|
my $status;
|
|
open(my $statusFH, "-|", "$RT_CMD", "show", "-f", 'Status', $ticketSpec);
|
|
while (my $statusLine = <$statusFH>) {
|
|
if ($statusLine =~ /\s*Status\s*:\s*(\S+)\s*$/) {
|
|
$status = $1;
|
|
last;
|
|
}
|
|
}
|
|
close $statusFH;
|
|
return $status;
|
|
}
|
|
###############################################################################
|
|
sub GetCustomFieldForTicket($$) {
|
|
my($ticketSpec, $customField) = @_;
|
|
open(my $rtCustomFH, "-|", "$RT_CMD", "show", "-f", 'CF.{' . $customField .'}', $ticketSpec);
|
|
my $val;
|
|
while (my $customFieldLine = <$rtCustomFH>) {
|
|
chomp $customFieldLine;
|
|
if ($customFieldLine =~ /^\s*CF\s*.\s*{$customField}\s*:\s*(\S+)\s*$/) {
|
|
$val = $1;
|
|
last;
|
|
}
|
|
}
|
|
close $rtCustomFH;
|
|
return $val;
|
|
}
|
|
###############################################################################
|
|
|
|
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);
|
|
|
|
$RT_CMD = '/usr/bin/rt' unless defined $RT_CMD;
|
|
|
|
$INTERACTIVE = 0 if not defined $INTERACTIVE;
|
|
|
|
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;
|
|
}
|
|
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);
|
|
}
|
|
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;
|
|
}
|
|
$VERBOSE = 0 unless defined $VERBOSE;
|
|
|
|
opendir(my $dh, $PAYMENT_DIR);
|
|
|
|
my $oldInterns = 0;
|
|
|
|
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);
|
|
$pass = ($pass =~ /success/) ? 1 : 0;
|
|
|
|
open(my $fh, "<", File::Spec->catfile($PAYMENT_DIR, $file));
|
|
my $mentorDate;
|
|
while (my $line = <$fh> ) {
|
|
if ($line =~ /^\s*Date\s*:\s*(.+)\s*$/) {
|
|
$mentorDate = UnixDate(ParseDate($1), "%Y-%m-%d");
|
|
next;
|
|
}
|
|
}
|
|
if (not defined $mentorDate) {
|
|
print STDERR "\"$file\": Skipping: Inside that file there is no valid Date: header" ;
|
|
next;
|
|
}
|
|
|
|
my(@nameComponents) = split(/\s*-\s*/, $name);
|
|
my(@searchTerms);
|
|
foreach my $name (@nameComponents) {
|
|
push(@searchTerms, 'Subject LIKE "' . $name . '"');
|
|
}
|
|
# Find the ticket number for this intern.
|
|
my $ticket = FindUniqueTicket(@searchTerms);
|
|
if (not defined $ticket) {
|
|
foreach my $term (@searchTerms) {
|
|
$ticket = FindUniqueTicket(($term));
|
|
last if (defined $ticket);
|
|
}
|
|
}
|
|
if (not defined $ticket) {
|
|
if (not $INTERACTIVE) {
|
|
print STDERR "\"$file\": Skipped: unable to to find a matching ticket.\n";
|
|
next;
|
|
} else {
|
|
# FIXME: prompt for ticket
|
|
die "interactive mode not yet supported";
|
|
}
|
|
}
|
|
my $completedInternshipField = GetCustomFieldForTicket($ticket, "completed-internship");
|
|
if (not defined $completedInternshipField) {
|
|
print STDERR "\"$file\": \"$ticket\": 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 "\"$file\": \"$ticket\": Skipping: cannot determine Entity from ticket.\n" ;
|
|
next;
|
|
}
|
|
|
|
if ($PAYMENT_NUMBER <= 1) {
|
|
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) {
|
|
print STDERR "\"$file\": \"$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;
|
|
|
|
my $lastPayDate = PaymentDateByTicket($ticket, $prevPayNum);
|
|
if (not defined $lastPayDate) {
|
|
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;
|
|
}
|
|
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;
|
|
}
|
|
$expectVal = 'payment-' . $prevPayNum . "-approved";
|
|
if ($completedInternshipField ne $expectVal) {
|
|
print STDERR "\"$file\": \"$ticket\": Skipped: completed-internship field was ",
|
|
"\"$completedInternshipField\" instead of \"$expectVal\".\n";
|
|
next;
|
|
}
|
|
|
|
my(@links) = GetLinksForTicket($ticket);
|
|
if ($VERBOSE > 5) {
|
|
print STDERR "\"$file\": \"$ticket\": Found the following links: " , join( ", ", @links), "\n";
|
|
}
|
|
my $taxTicket = FindTaxTicketFromList(@links);
|
|
if (not defined $taxTicket) {
|
|
print STDERR "\"$file\": \"$ticket\": Skipped: no tax ticket found.\n";
|
|
next;
|
|
}
|
|
my $reimbursementTicket = FindReimbursementTicketFromList(@links);
|
|
if (not defined $reimbursementTicket) {
|
|
print STDERR "\"$file\": \"$ticket\": Skipped: no reimbursement ticket found.\n";
|
|
next;
|
|
}
|
|
print STDERR "\"$file\": \"$ticket\": found a tax ticket of \"$taxTicket\"\n" if ($VERBOSE > 5);
|
|
my $taxTicketStatus = GetStatusFromTicket($taxTicket);
|
|
if ($taxTicketStatus ne "resolved") {
|
|
print STDERR "\"$file\": \"$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 "\"$file\": \"$ticket\": PREV-PAYMENT-INCOMPLETE: Skipped: ",
|
|
"ticket is in status \"$mainTicketStatus\" instead of \"needs-project-ok\"\n";
|
|
next;
|
|
}
|
|
}
|
|
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:
|