2018-07-25 16:40:30 +00:00
|
|
|
#!/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);
|
|
|
|
|
2020-04-09 16:52:04 +00:00
|
|
|
my($VERBOSE, $INTERACTIVE, $RT_CMD, $SVN_CMD, %AMOUNTS, $SHOW_AMOUNTS, $QUERY_STRING, $SUB_TOTALS);
|
2018-07-25 16:40:30 +00:00
|
|
|
|
|
|
|
###############################################################################
|
|
|
|
sub TicketIDsReadyForPayment () {
|
|
|
|
my @ticketSpecs;
|
2020-04-09 16:26:46 +00:00
|
|
|
my $queryString = $QUERY_STRING;
|
|
|
|
|
|
|
|
if (not defined $queryString or $queryString =~ /^\s*$/) {
|
|
|
|
$queryString = "Status = 'ready-for-payment' and Owner = 'bkuhn' and Queue = 'outreachy-interns' and Subject like '%2019-12%'";
|
|
|
|
$queryString = "Status = 'ready-for-payment' and Owner = 'bkuhn' and Due < '2020-04-30'";
|
|
|
|
$queryString = "Status = 'ready-for-payment'";
|
|
|
|
$queryString = "Status = 'ready-for-payment' and 'CF.{payment-method}' = 'USD PayPal'";
|
|
|
|
$queryString = "Status = 'ready-for-payment'";
|
|
|
|
}
|
|
|
|
print "Using $queryString\n";
|
|
|
|
open(my $rtLsFH, "-|", "$RT_CMD", "ls", "-i", $queryString);
|
2018-08-23 20:53:13 +00:00
|
|
|
print "Running: rt ls -i Status=ready-for-payment\n" if ($VERBOSE >= 10);
|
2020-04-09 16:26:46 +00:00
|
|
|
|
2018-07-25 16:40:30 +00:00
|
|
|
while (my $lsLine = <$rtLsFH>) {
|
2018-08-23 20:53:13 +00:00
|
|
|
print "rt ls line from Ready for payment search: $lsLine" if ($VERBOSE >= 10);
|
2018-07-25 16:40:30 +00:00
|
|
|
chomp $lsLine;
|
2018-08-23 20:53:13 +00:00
|
|
|
next if $lsLine =~ /^\s*$/; # There are sometimes blank lines in the rt ls -i output,
|
|
|
|
push(@ticketSpecs, $lsLine); # particularly with 0 results, and no empty strings go on this list
|
2018-07-25 16:40:30 +00:00
|
|
|
}
|
2018-08-23 20:53:13 +00:00
|
|
|
print "Done: rt ls -i Status=ready-for-payment\n" if ($VERBOSE >= 10);
|
2018-07-25 16:40:30 +00:00
|
|
|
close $rtLsFH;
|
|
|
|
return @ticketSpecs;
|
|
|
|
}
|
|
|
|
###############################################################################
|
|
|
|
sub FindMostRecentPaymentMethodForTicket ($) {
|
|
|
|
my($ticketSpec) = @_;
|
|
|
|
my $paymentMethod;
|
2018-07-25 16:44:19 +00:00
|
|
|
$ticketSpec =~ s%^\s*ticket\s*/\s*%%;
|
2020-04-09 16:26:46 +00:00
|
|
|
open(my $rtShowFH, "-|", "$RT_CMD", "show", '-t', 'ticket', '-f', 'CF.{payment-method}', $ticketSpec);
|
|
|
|
my($ticketDataAgain, $value) = <$rtShowFH>;
|
|
|
|
close $rtShowFH;
|
2020-07-21 20:50:43 +00:00
|
|
|
chomp $value; $value =~ s/^\s*cf.\{payment-method\}\s*:\s+(.*)$/$1/i
|
2020-04-09 16:26:46 +00:00
|
|
|
or warn "$ticketSpec: Unknown value for payment-method of \"$value\"";
|
2020-07-21 20:50:43 +00:00
|
|
|
|
2020-04-09 16:26:46 +00:00
|
|
|
if (not defined $value or $value =~ /^\s*$/) {
|
|
|
|
$value = "NO-CF-SET";
|
|
|
|
}
|
2020-07-21 20:50:43 +00:00
|
|
|
if ($SHOW_AMOUNTS) {
|
|
|
|
open(my $rtShowFH, "-|", "$RT_CMD", "show", '-t', 'ticket', '-f', 'CF.{payment-amount}', $ticketSpec);
|
|
|
|
my($ticketDataYetAgain, $curAndAmount) = <$rtShowFH>;
|
|
|
|
close $rtShowFH;
|
|
|
|
chomp $curAndAmount; $curAndAmount =~ s/^\s*cf.\{payment-amount\}\s*:\s+(.*)$/$1/i;
|
|
|
|
$ticketSpec =~ s%^\s*ticket\s*/\s*%%;
|
|
|
|
$curAndAmount = "USD -32767.69" if not defined $curAndAmount;
|
|
|
|
$curAndAmount =~ /^\s*([A-Z]{3,3})\s+([\-\d\,\.]+)\s*$/ or die "Ticket, $ticketSpec, has amount of $curAndAmount";
|
|
|
|
($AMOUNTS{$ticketSpec}{currency}, $AMOUNTS{$ticketSpec}{amount}) = ($1, $2);
|
|
|
|
$AMOUNTS{$ticketSpec}{amount} =~ s/\$//g; $AMOUNTS{$ticketSpec}{amount} =~ s/,//g;
|
|
|
|
$AMOUNTS{$ticketSpec}{currency} =~ s/\s//g;
|
2018-07-25 16:40:30 +00:00
|
|
|
}
|
2020-07-21 20:50:43 +00:00
|
|
|
return $value;
|
2018-07-25 16:40:30 +00:00
|
|
|
}
|
|
|
|
###############################################################################
|
|
|
|
|
2020-04-09 16:26:46 +00:00
|
|
|
GetOptions("verbose=i" => \$VERBOSE, "interactive" => \$INTERACTIVE, 'showAmounts' => \$SHOW_AMOUNTS,
|
2020-04-09 16:52:04 +00:00
|
|
|
'subTotals' => \$SUB_TOTALS,
|
2020-04-09 16:26:46 +00:00
|
|
|
"rtCommand=s" => \$RT_CMD, "svnCommand=s" => \$SVN_CMD, 'queryString=s' => \$QUERY_STRING);
|
2020-04-09 16:52:04 +00:00
|
|
|
$SHOW_AMOUNTS = 1 if $SUB_TOTALS;
|
2018-07-25 16:40:30 +00:00
|
|
|
|
|
|
|
$RT_CMD = '/usr/bin/rt' unless defined $RT_CMD;
|
|
|
|
$SVN_CMD = '/usr/bin/svn' unless defined $SVN_CMD;
|
|
|
|
|
|
|
|
$INTERACTIVE = 0 if not defined $INTERACTIVE;
|
|
|
|
|
|
|
|
my @ticketSpecs = TicketIDsReadyForPayment();
|
|
|
|
|
2018-08-23 20:53:32 +00:00
|
|
|
if (@ticketSpecs <= 0) {
|
|
|
|
print "No tickets found that are ready for payment at this time\n";
|
|
|
|
exit 0;
|
|
|
|
}
|
|
|
|
|
2018-07-25 16:40:30 +00:00
|
|
|
my %payments;
|
2020-04-09 16:32:58 +00:00
|
|
|
|
|
|
|
print "Total tickets ready for payment is: ", scalar(@ticketSpecs), "\n\n";
|
2018-07-25 16:44:14 +00:00
|
|
|
foreach my $ticketSpec (@ticketSpecs) {
|
2018-07-25 16:40:30 +00:00
|
|
|
my $paymentMethod = FindMostRecentPaymentMethodForTicket($ticketSpec);
|
2018-08-07 17:32:09 +00:00
|
|
|
print STDERR "$ticketSpec has payment method of $paymentMethod\n" if ($VERBOSE > 6);
|
|
|
|
if (not defined $paymentMethod) {
|
|
|
|
warn "Cannot find payment method for ticket, $ticketSpec";
|
|
|
|
$paymentMethod = "UNKNOWN PAYMENT METHOD";
|
|
|
|
}
|
2018-07-25 16:40:30 +00:00
|
|
|
push(@{$payments{$paymentMethod}}, $ticketSpec);
|
|
|
|
}
|
2020-04-09 16:32:58 +00:00
|
|
|
print "#" x 70, "\n";
|
2020-07-21 20:50:43 +00:00
|
|
|
my $overallTotalOk = 1;
|
|
|
|
my %overallTotals;
|
2018-07-25 16:40:30 +00:00
|
|
|
foreach my $paymentMethod (sort { $a cmp $b } keys %payments) {
|
|
|
|
print "$paymentMethod: Count: ", scalar(@{$payments{$paymentMethod}}), "\n";
|
2020-04-09 16:32:58 +00:00
|
|
|
print " Tickets: ", join(" ", map { s%^\s*ticket\s*/\s*%%; $_; } @{$payments{$paymentMethod}}), "\n";
|
2020-07-21 20:50:43 +00:00
|
|
|
my $subTotalOk = 1;
|
|
|
|
my %subTotals;
|
2020-04-09 16:52:04 +00:00
|
|
|
if ($SUB_TOTALS) {
|
|
|
|
foreach my $tix (@{$payments{$paymentMethod}}) {
|
|
|
|
$tix =~ s%^\s*ticket\s*/\s*%%;
|
2020-07-21 20:50:43 +00:00
|
|
|
my($currency, $val) = ($AMOUNTS{$tix}{currency}, $AMOUNTS{$tix}{amount});
|
|
|
|
$subTotals{$currency} = 0.00 unless defined $subTotals{$currency};
|
|
|
|
print sprintf(" %5d: %.2f %3.3s\n", $tix, $val, $currency);
|
|
|
|
if (defined $val and $val =~ /^[\d\.]+$/) { $subTotals{$currency} += $val; } else { $subTotalOk = 0; }
|
2020-04-09 16:52:04 +00:00
|
|
|
}
|
|
|
|
if ($subTotalOk) {
|
2020-07-21 20:50:43 +00:00
|
|
|
print sprintf("%30s", "SUBTOTAL for $paymentMethod\n");
|
|
|
|
foreach my $currency (keys %subTotals) {
|
|
|
|
print sprintf("%30s %.2f %3.3s\n\n", " ", $subTotals{$currency}, $currency);
|
|
|
|
$overallTotals{$currency} = 0.00 unless defined $overallTotals{$currency};
|
|
|
|
$overallTotals{$currency} += $subTotals{$currency};
|
|
|
|
}
|
2020-04-09 16:52:04 +00:00
|
|
|
} else {
|
|
|
|
$overallTotalOk = 0;
|
|
|
|
}
|
|
|
|
}
|
2020-04-09 16:32:58 +00:00
|
|
|
}
|
2020-04-09 16:52:04 +00:00
|
|
|
if ($SHOW_AMOUNTS and not $SUB_TOTALS) {
|
2020-04-09 16:32:58 +00:00
|
|
|
print "Unable to find amounts for all tickets\n" if (scalar(@ticketSpecs) != scalar(keys %AMOUNTS));
|
|
|
|
foreach my $tix (sort { $a <=> $b} (keys %AMOUNTS)) {
|
2020-07-21 20:50:43 +00:00
|
|
|
foreach my $currency (keys %overallTotals) {
|
|
|
|
my $val = $AMOUNTS{$tix}{$currency};
|
|
|
|
print sprintf("%5d: %.2f %3.3d\n", $tix, $val, $currency);
|
|
|
|
$overallTotals{$currency} = 0.00 unless defined $overallTotals{$currency};
|
|
|
|
if ($val =~ /^[\d\.]+$/) { $overallTotals{$currency} += $val; } else { $overallTotalOk = 0; }
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if ($overallTotalOk and $SHOW_AMOUNTS) {
|
|
|
|
print sprintf("%30s:\n", "TOTAL AMOUNT");
|
|
|
|
foreach my $currency (keys %overallTotals) {
|
|
|
|
print sprintf("%30s %.2f %3.3s\n\n", " ", $overallTotals{$currency}, $currency);
|
2020-04-09 16:32:58 +00:00
|
|
|
}
|
2018-07-25 16:40:30 +00:00
|
|
|
}
|
|
|
|
###############################################################################
|
|
|
|
#
|
|
|
|
# Local variables:
|
|
|
|
# compile-command: "perl -c rt-bulk-prep-pay.plx"
|
|
|
|
# perl-indent-level: 2
|
|
|
|
# End:
|