#!/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= 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= 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= 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= 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= 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: