#!/usr/local/bin/perl
#
# Modify balance/GrpCpuMins in Slurm (NOT PDB) for a specific 
# coop project.
# See also slurm_modify_account_balance for a project

use strict;
use warnings;

use POSIX qw(floor);
use Getopt::Long;
use Carp qw(carp croak);

use lib '/cell_root/software/HPCC/lib/site_perl';
use Glue::HPCC::Cluster;
use Glue::HPCC::Project::Log;
use Glue::HPCC::Project::Project;
use Glue::HPCC::Project::ProjectType;
use Glue::HPCC::ClusterUtil;
#Only valid for Slurm
use Glue::HPCC::ClusterUtil::Slurm::Project;


my $GHPLog = 'Glue::HPCC::Project::Log';
my $GHPProj = 'Glue::HPCC::Project::Project';
my $GHPPType = 'Glue::HPCC::Project::ProjectType';

my $ksufmt = "%-0.3f";
my $minfmt = "%-d";
my $fmt = "%-12s %-10s %-10s %-10s %-10s\n";
my $deltafmt = $fmt;


sub usage()
{	print STDERR <<EOF;
$0: Modify ksu balance for coop project in Slurm

This modifies the balances (GrpCPUMins) in Slurm
for the two accounts in a co-op project.
It DOES NOT touch the Projects DB (except to update logs)

Usage:

$0 [ -cluster CLUSTER ] [ --force ] [ --dryrun ] [-querymode] \
	-reason REASON -project PROJECT
	-unit UNIT -mode MODE -amount AMOUNT [ FLAGS ]

CLUSTER will default based on system running command on.
REASON will get logged to the PDB
PROJECT is the name of the __project__ to modify
UNIT should be one of SU, kSU, CPUmin
MODE should be one of set, add, sub
AMOUNT is the amount (in units of UNIT) to set, add, or sub (see MODE)

Unless --force is given, user will be prompted before 
anything is done.  In --querymode, will only show the results of
the calculations and exit.

This is for co-op type projects.  The new amount (either AMOUNT
or current amount +/- AMOUNT) will be considered the new
AFTER TAX quarterly allocation (although PDB will NOT be modified).
High priority account will have its limit set to 1/3 the new amount.
Std priority account will have its limit adjusted by the difference
between the new and old quarterly allocation value, less what went
into the high priority account.

FLAGS allows one to supress warnings.  Without the FLAGS, warnings
will be printed and you will be prompted whether to continue.
Allowed FLAGS are
--allow_neg_std_limit: Won't complain if limit on std goes negative
--allow_neg_tot_limit: Won't complain if limit on combined (hi+std) goes negative
--allow_neg_high_balance: Won't complain if balance on high goes negative
--allow_neg_std_balance: Won't complain if balance on std goes negative
--allow_neg_tot_balance: Won't complain if balance on combined goes negative
--fake-std-usage=X: For debugging; pretend usage on std is X kSU
--fake-high-usage=X: For debugging; pretend usage on high is X kSU

EOF
}

sub slurm_modify_coop_balances(@)
#Modify the account balances in Slurm for a coop project
#Takes key => value argument pairs, recognizing:
#	slrmproj:  Glue::HPCC::ClusterUtil::Slurm::Project instance, required (should become $self?)
#	hpc: Glue::HPCC instance, required.
#	project: Name of the coop type project to modify.  Required
#	newSU: the new size of the allocation, in SU. Required.
#	reason: text reason for change, for logs
#	flags: A hash ref of flags for this operation.
#		See below.	
#
#On success, returns a hash ref summarizing what was done
#(or would have been done if dryrun flag was not set).  The
#keys are:
#	oldSU: the old project size, in SU
#	newSU: the new project size, in SU (should match newSU above)
#	old_high_cpumin_lim: the old GrpCPUMins lim on high priority account (cpumins)
#	new_high_cpumin_lim: the new GrpCPUMins lim on high priority account (cpumins)
#	old_std_cpumin_lim: the old GrpCPUMins lim on std priority account (cpumins)
#	new_std_cpumin_lim: the new GrpCPUMins lim on std priority account (cpumins)
#	high_cpumin_used: the usage on high priority account (cpumins) 
#	std_cpumin_used: the usage on std priority account (cpumins) 
#	old_high_cpumin_bal: the old high priority account balance (cpumins)
#	new_high_cpumin_bal: the new high priority account balance (cpumins)
#	old_std_cpumin_bal: the old std priority account balance (cpumins)
#	new_std_cpumin_bal: the new std priority account balance (cpumins)
#	errorflag: False on success, true if had problems (brief error type)
#	errortext: More descriptive error text if error
#
#Errorflag values can be:
#	undef: no error, things went as expected.
#	dryrun: no error, but were in dryrun mode
#	unknown: unrecognized error.  Something major went wrong.
#	stdlim<0: The req xact would bring limit on std acct < 0 and flag to ignore not set
#	totlim<0: The req xact would bring limit on both hi and std < 0 and flag to ignore not set
#	hibal<0: The req xact would bring balance on hipri acct < 0 and no flag to ignore
#	stdbal<0: The req xact would bring balance on std acct < 0 and no flag to ignore
#	totbal<0: The req xact would bring balance on both accts < 0 and no flag to ignore
#
#Recognized flags are:
#	dryrun: This differs from most dryrun arguments.
#		If this is set, the calculation of values is done as normal,
#		but no changes made (routines to make changes are not even called).
#	ignore_stdlim<0: Proceed past stdlim<0 errors
#	ignore_totlim<0: Proceed past totlim<0 errors
#	ignore_hibal<0: Proceed past hibal<0 errors
#	ignore_stdbal<0: Proceed past stdbal<0 errors
#	ignore_totbal<0: Proceed past totbal<0 errors
#	fake_std_cpumin_used: For debugging, pretend used=X on std acct (in cpumin)
#	fake_high_cpumin_used: For debugging, pretend used=X on high acct (in cpumin)
#	
{	my %args = @_;
	my $me = 'slurm_modify_coop_balances';
	my $hpc = delete $args{hpc};
	my $slrmproj = delete $args{slrmproj};
	my $project = delete $args{project};
	my $newSU = delete $args{newSU};
	my $flags = delete $args{flags} || {};
	my $reason = delete $args{reason};

	croak "$me: Missing required argument 'hpc' at "
		unless $hpc;
	croak "$me: Missing required argument 'slrmproj' at "
		unless $slrmproj;
	croak "$me: Missing required argument 'project' at "
		unless $project;
	croak "$me: Missing required argument 'reason' at "
		unless $reason;
	croak "$me: Missing required argument 'newSU' at "
		unless defined $newSU;
	croak "$me: Invalid argument newSU='$newSU', want non-neg number, at "
		unless ( $newSU =~ /^\d+(\.\d*)?$/ || $newSU =~ /^\.\d+$/ );
	croak "$me: Invalid argument flags, want hash ref got $flags at "
		unless ref($flags) eq 'HASH';
	if (%args)
	{	my $tmp = join ', ', (keys %args);
		croak "$me: Extraneous arguments [ $tmp ], aborting at ";
	}

	my $sacctmgr = $slrmproj->sacctmgr;
	my $sshare = $slrmproj->sshare;
	my $tmp;

	my $proj = $GHPProj->project_by_name( $hpc, $project);
	croak "$me: Unrecognized project $project at " unless $proj;
	croak "$me: Error looking up project $project: $proj at "
		unless ref($proj);

	my $ptid = $proj->projtype;
	my $ptype = $GHPPType->projecttype_by_pkey($hpc, $ptid);
	croak "$me: Could not find project type pkey=$ptid at "
		unless $ptype;
	croak "$me: Error looking up ptype for $project ($ptid): $ptype at "
		unless ref($ptype);
	my $ptname = $ptype->name;

	croak "$me: Project $project is type $ptname, not coop at "
		unless $ptname eq 'coop';

	my $oldSU = $proj->su;
	my $newcpumin = floor($newSU * 60 + 0.5); #Must be integer
	my $oldcpumin = floor($oldSU * 60 + 0.5);
	my $deltacpumin = $newcpumin - $oldcpumin; #Can be negative
	my $acct_std = $project;
	my $acct_hi = $project . '-hi';
	my $cluster = $hpc->db_clustername;
	my ($errorflag, $errortext);
	my $ksufmt = "%-0.3f"; #For error text
	
	# Get current balances for high and std priority accounts
	$tmp = $sshare->usage_for_account_in_cluster(
		account=>$acct_std, cluster=>$cluster);
	unless ( $tmp && ref($tmp) eq 'ARRAY' )
	{	croak "$me: Error looking up balance for $acct_std in $cluster: $tmp at ";
	}
	my $old_std_cpumin_lim = floor($tmp->[1] + 0.5); #Must be integer
	my $old_std_cpumin_bal = floor($tmp->[2] + 0.5);
	my $std_cpumin_used = floor($tmp->[0]/60 + 0.5);
	if ( exists $flags->{fake_std_cpumin_used} )
	{	#For testing/debugging, pretend usage is something else
		$std_cpumin_used = floor($flags->{fake_std_cpumin_used}+ 0.5);
		$old_std_cpumin_bal = floor($old_std_cpumin_lim - $std_cpumin_used + 0.5);
	}

	$tmp = $sshare->usage_for_account_in_cluster(
		account=>$acct_hi, cluster=>$cluster);
	unless ( $tmp && ref($tmp) eq 'ARRAY' )
	{	croak "$me: Error looking up balance for $acct_hi in $cluster: $tmp at ";
	}
	my $old_high_cpumin_lim = floor($tmp->[1] + 0.5); #Must be integer
	my $old_high_cpumin_bal = floor($tmp->[2] + 0.5);
	my $high_cpumin_used = floor($tmp->[0]/60 + 0.5);
	if ( exists $flags->{fake_high_cpumin_used} )
	{	#For testing/debugging, pretend usage is something else
		$high_cpumin_used = floor($flags->{fake_high_cpumin_used}+ 0.5);
		$old_high_cpumin_bal = floor($old_high_cpumin_lim - $high_cpumin_used + 0.5);
	}

	#Calculate new std/high limits

	my $new_high_cpumin_lim = floor($newcpumin/3 + 0.5); #Must be integer, will always be non-negative at this point
	my $high_delta_cpumin = $new_high_cpumin_lim - $old_high_cpumin_lim;
	my $new_std_cpumin_lim = $old_std_cpumin_lim + $deltacpumin - $high_delta_cpumin;

	#Validate that limits >= 0

	if ( $new_std_cpumin_lim < 0 )
	{	#Std depleted, warn and reduce high to compensate
		$tmp = sprintf $ksufmt, $new_std_cpumin_lim/60/1000;
		unless ( $flags->{'ignore_stdlim<0'} )
		{	$errorflag = 'stdlim<0';
			$errortext = <<EOF;
Requested transaction would bring the limit on 
$acct_std ($tmp kSU) below 0.
If you choose to proceed, we will try to reduce
$acct_hi to cover.
EOF
			return {errorflag=>$errorflag, errortext=>$errortext};
		}

	
		if ( $new_high_cpumin_lim + $new_std_cpumin_lim < 0 )
		{	#Not enough in high to cover, warn and set both to zero
			unless ( $flags->{'ignore_totlim<0'} )
			{   $tmp = sprintf $ksufmt, 
				-($new_std_cpumin_lim + $new_high_cpumin_lim)/60/1000;
			    $errorflag='totlim<0';
			    $errortext = <<EOF;
Requested transaction would bring the limit on both
$acct_std and $acct_hi below 0.
If you choose to proceed, we will just zero both
(and debt of $tmp kSU vanishes).
EOF
			    return {errorflag=>$errorflag, errortext=>$errortext};
			}
			$new_high_cpumin_lim = $new_std_cpumin_lim = 0;
		} else
		{	#Just deduct from high 
			#($new_std_cpumin_lim < 0, so adding deducts)
			$new_high_cpumin_lim += $new_std_cpumin_lim;
			$new_std_cpumin_lim = 0;
		}
	}

	# Get new balances for high and std priority accounts
	my $new_high_cpumin_bal = $new_high_cpumin_lim - $high_cpumin_used;
	my $new_std_cpumin_bal = $new_std_cpumin_lim - $std_cpumin_used;

	#Validate that balances >= 0

	if ( $new_high_cpumin_bal < 0 || $new_std_cpumin_bal < 0 )
	{	#At least one balance would be negative

		if ( $new_high_cpumin_bal < 0 && $new_std_cpumin_bal >= 0 
			&& ! $flags->{'ignore_hibal<0'} )
		{   $tmp = sprintf $ksufmt, $new_high_cpumin_bal/60/1000;
		    $errorflag = 'hibal<0';
		    $errortext = <<EOF;
Requested transaction would bring balance on
$acct_hi ($tmp kSU) below 0.  
If you choose to proceed, we will try to cover
deficit with funds from $acct_std.
EOF
		    return { errorflag=>$errorflag, errortext=>$errortext };
		}

		if ( $new_std_cpumin_bal < 0 && $new_high_cpumin_bal >= 0 
			&& ! $flags->{'ignore_stdbal<0'} )
		{   $tmp = sprintf $ksufmt, $new_std_cpumin_bal/60/1000;
		    $errorflag = 'stdbal<0';
		    $errortext = <<EOF;
Requested transaction would bring balance on
$acct_std ($tmp kSU) below 0.  
If you choose to proceed, we will try to cover
deficit with funds from $acct_hi.
EOF
		    return { errorflag=>$errorflag, errortext=>$errortext };
		}

		if ( $new_high_cpumin_bal + $new_std_cpumin_bal < 0 )
		{	#Would bring total balance < 0
			unless ( $flags->{'ignore_totbal<0'} )
			{	$tmp = sprintf $ksufmt, 
				   -($new_std_cpumin_bal + $new_high_cpumin_bal)/60/1000;
				$errorflag = 'totbal<0';
				$errortext = <<EOF;
Requested transaction would bring balances on
both $acct_hi and $acct_std below 0.  
If you choose to proceed, we will leave both with  
zero balances (effectively $tmp kSU overusage ignored).
EOF
		     		return { errorflag=>$errorflag, errortext=>$errortext };
			}

			if ( $new_high_cpumin_bal > 0 )
			{	#Have balance in high, give it to std
				$new_high_cpumin_lim -= $new_high_cpumin_bal; 
				$new_std_cpumin_lim  += $new_high_cpumin_bal;
				$new_std_cpumin_bal  += $new_high_cpumin_bal;
				$new_high_cpumin_bal  = 0;
			} elsif ( $new_std_cpumin_bal > 0 )
			{	#Have balance in std, give it to high
				$new_std_cpumin_lim  -= $new_std_cpumin_bal;
				$new_high_cpumin_lim += $new_std_cpumin_bal; 
				$new_high_cpumin_bal += $new_std_cpumin_bal;
				$new_std_cpumin_bal   = 0;
			}
			#Nothing really to do if both < 0

		} elsif ( $new_high_cpumin_bal < 0 )
		{	#High balance < 0, but std has enough to cover
			$tmp = -$new_high_cpumin_bal; # >0
			$new_high_cpumin_lim += $tmp;
			$new_high_cpumin_bal += $tmp;
			$new_std_cpumin_lim  -= $tmp;
			$new_std_cpumin_bal  -= $tmp;
		} elsif ( $new_std_cpumin_bal < 0 )
		{	#Std balance < 0, but high has enough to cover
			$tmp = -$new_std_cpumin_bal; #>0
			$new_std_cpumin_lim  += $tmp;
			$new_std_cpumin_bal  += $tmp;
			$new_high_cpumin_lim -= $tmp;
			$new_high_cpumin_bal -= $tmp;
		} else
		{	die "Should not reach here at ";
		}
	}

	#OK, so far successful
	#Generate our results hash

	my $results =
	{	errorflag => undef,
		errortext => undef,
		oldSU => $oldSU,
		newSU => $newSU,
		old_high_cpumin_lim => $old_high_cpumin_lim,
		new_high_cpumin_lim => $new_high_cpumin_lim,
		old_std_cpumin_lim => $old_std_cpumin_lim,
		new_std_cpumin_lim => $new_std_cpumin_lim,
		high_cpumin_used => $high_cpumin_used,
		std_cpumin_used => $std_cpumin_used,
		old_high_cpumin_bal => $old_high_cpumin_bal,
		new_high_cpumin_bal => $new_high_cpumin_bal,
		old_std_cpumin_bal => $old_std_cpumin_bal,
		new_std_cpumin_bal => $new_std_cpumin_bal,
	};

	if ( $flags->{dryrun} )
	{	$results->{errorflag} = 'dryrun';
		return $results;
	}

	#Really do it
	my $res;

	#Reset high priority account
	$res = $slrmproj->sacctmgr_reset_account_balances(
		account => $acct_hi, cluster=> $cluster,
		zero_usage => 0, cpumin => $new_high_cpumin_lim);
	if ( $res )
	{	$results->{errorflag} = 'unknown';
		$results->{errortext} = "Error reseting account balance on $acct_hi: $res";
		return $results;
	}

	#Log what we did
	$GHPLog->add_log_entry($hpc,
		action_code => 'modify-acct-bal',
		reason => $reason,
		account => $acct_hi,
		cluster => $cluster,
		tablename => 'slurm',
		fieldname => 'GrpCPUMin',
		oldval => $old_high_cpumin_lim,
		newval => $new_high_cpumin_lim,
		description => 'Manually reset GrpCPUMin limit on account'
	);
	$hpc->db_commit; #And commit the log (since Slurm action autocommitted)

	#Reset std priority account
	$res = $slrmproj->sacctmgr_reset_account_balances(
		account => $acct_std, cluster=> $cluster,
		zero_usage => 0, cpumin => $new_std_cpumin_lim);
	if ( $res )
	{	$results->{errorflag} = 'unknown';
		$results->{errortext} = "Error reseting account balance on $acct_std: $res";
		return $results;
	}

	#Log what we did
	$GHPLog->add_log_entry($hpc,
		action_code => 'modify-acct-bal',
		reason => $reason,
		account => $acct_std,
		cluster => $cluster,
		tablename => 'slurm',
		fieldname => 'GrpCPUMin',
		oldval => $old_std_cpumin_lim,
		newval => $new_std_cpumin_lim,
		description => 'Manually reset GrpCPUMin limit on account'
	);
	$hpc->db_commit;
	return $results;
}

sub yorn_abort(;$)
{	my $prompt = shift || 'Proceed? (y/N)?';
	print STDERR "\n$prompt ";
	my $ans = <STDIN>;
	chomp $ans;
	unless ( $ans =~ /^\s*y(es?)?\s*$/i )
	{	die "Aborted at user request.\n";
	}
	return;
}

sub warn_or_abort($)
{	my $warning = shift;
	print STDERR <<EOF;
============================================
	***** WARNING ******
============================================

$warning

EOF
	yorn_abort;
}


sub print_confirmation_line(;$$$)
{	my $fld = shift;
	my $oldm = shift;
	my $newm = shift;

	my ($oldk, $newk);
	if ($fld)
	{	$oldm = sprintf $minfmt, $oldm;
		$oldk = sprintf $ksufmt, $oldm/60/1000;
		if ( $newm ne '-' )
		{	$newm = sprintf $minfmt, $newm;
			$newk = sprintf $ksufmt, $newm/60/1000;
		}
	} else
	{	$fld = '';
		$oldk = 'Old(kSU)';
		$newk = 'New(kSU)';
		$oldm = 'Old(min)';
		$newm = 'New(min)';
	}

	printf STDERR $fmt, $fld, $oldk, $newk, $oldm, $newm;
}

sub print_confirmation_deltaline(;$$$)
{	my $fld = shift;
	my $dlim_m = shift;
	my $dbal_m = shift;

	my ($dlim_k, $dbal_k);
	if ($fld)
	{	$dlim_m = sprintf $minfmt, $dlim_m;
		$dlim_k = sprintf $ksufmt, $dlim_m/60/1000;
		$dbal_m = sprintf $minfmt, $dbal_m;
		$dbal_k = sprintf $ksufmt, $dbal_m/60/1000;
	} else
	{	$fld = 'Deltas';
		$dlim_k = 'Limit(kSU)';
		$dlim_m = 'Limit(min)';
		$dbal_k = 'EBal(kSU)';
		$dbal_m = 'EBal(min)';
	}

	printf STDERR $deltafmt, $fld, $dlim_k, $dbal_k, $dlim_m, $dbal_m;
}

sub dump_results($$$)
{	my $project = shift;
	my $cluster = shift;
	my $results = shift;

	my $cur_qmin = $results->{oldSU} * 60;
	my $new_qmin = $results->{newSU} * 60;

	my $curstd_cpumin_limit = $results->{old_std_cpumin_lim};
	my $newstd_cpumin_limit = $results->{new_std_cpumin_lim};
	my $std_cpumin_used     = $results->{std_cpumin_used};
	my $curstd_cpumin_bal   = $results->{old_std_cpumin_bal};
	my $newstd_cpumin_bal   = $results->{new_std_cpumin_bal};

	my $curhi_cpumin_limit = $results->{old_high_cpumin_lim};
	my $newhi_cpumin_limit = $results->{new_high_cpumin_lim};
	my $hi_cpumin_used     = $results->{high_cpumin_used};
	my $curhi_cpumin_bal   = $results->{old_high_cpumin_bal};
	my $newhi_cpumin_bal   = $results->{new_high_cpumin_bal};

	my $std_delta_cpumin  = $newstd_cpumin_limit - $curstd_cpumin_limit;
	my $high_delta_cpumin = $newhi_cpumin_limit - $curhi_cpumin_limit;
	my $std_dbal_cpumin = $newstd_cpumin_bal - $curstd_cpumin_bal;
	my $high_dbal_cpumin = $newhi_cpumin_bal - $curhi_cpumin_bal;

	#Effective balances: consider balances < 0 as 0, not negative
	my $newstd_cpumin_ebal = ($newstd_cpumin_bal<0)?0:($newstd_cpumin_bal);
	my $curstd_cpumin_ebal = ($curstd_cpumin_bal<0)?0:($curstd_cpumin_bal);
	my $newhi_cpumin_ebal = ($newhi_cpumin_bal<0)?0:($newhi_cpumin_bal);
	my $curhi_cpumin_ebal = ($curhi_cpumin_bal<0)?0:($curhi_cpumin_bal);
	my $std_edbal_cpumin = $newstd_cpumin_ebal - $curstd_cpumin_ebal;
	my $high_edbal_cpumin = $newhi_cpumin_ebal - $curhi_cpumin_ebal;

	print STDERR <<EOF;
Cluster: $cluster
Project: $project

EOF
	print_confirmation_line;

	print_confirmation_line 'Qtrly Alloc', 
		$cur_qmin, $new_qmin;
	print STDERR "\n";

	print_confirmation_line 'Std Limit', 
		$curstd_cpumin_limit, $newstd_cpumin_limit;
	print_confirmation_line 'Std Used',
		$std_cpumin_used, $std_cpumin_used;
	print_confirmation_line 'Std Balance',
		$curstd_cpumin_bal, $newstd_cpumin_bal;
	print_confirmation_line 'Std EffBal',
		$curstd_cpumin_ebal, $newstd_cpumin_ebal;
	print STDERR "\n";

	print_confirmation_line 'Hi Limit', 
		$curhi_cpumin_limit, $newhi_cpumin_limit;
	print_confirmation_line 'Hi Used',
		$hi_cpumin_used, $hi_cpumin_used;
	print_confirmation_line 'Hi Balance',
		$curhi_cpumin_bal, $newhi_cpumin_bal;
	print_confirmation_line 'Hi EffBal',
		$curhi_cpumin_ebal, $newhi_cpumin_ebal;
	print STDERR "\n";

	print_confirmation_line 'Tot Limit', 
		($curhi_cpumin_limit + $curstd_cpumin_limit), 
		($newhi_cpumin_limit + $newstd_cpumin_limit);
	print_confirmation_line 'Tot Used',
		($hi_cpumin_used + $std_cpumin_used),
		($hi_cpumin_used + $std_cpumin_used);
	print_confirmation_line 'Tot Balance',
		($curhi_cpumin_bal + $curstd_cpumin_bal), 
		($newhi_cpumin_bal + $newstd_cpumin_bal);
	print_confirmation_line 'Tot EffBal',
		($curhi_cpumin_ebal + $curstd_cpumin_ebal), 
		($newhi_cpumin_ebal + $newstd_cpumin_ebal);
	print STDERR "\n";

	print_confirmation_deltaline;
	print_confirmation_deltaline 'Standard', 
		$std_delta_cpumin, $std_edbal_cpumin;
	print_confirmation_deltaline 'High', 
		$high_delta_cpumin, $high_edbal_cpumin;
	print_confirmation_deltaline 'Combined', 
		($std_delta_cpumin + $high_delta_cpumin),
		($std_edbal_cpumin  + $high_edbal_cpumin) ;
	print_confirmation_deltaline 'Requested', 
		($new_qmin - $cur_qmin), ($new_qmin - $cur_qmin);
	print STDERR "\n";
}

sub confirm_action($$$)
{	my $project = shift;
	my $cluster = shift;
	my $results = shift;

	print STDERR <<EOF;
--------------------------------------
Confirmation of PROJECT balance modification:

EOF
	dump_results($project,$cluster,$results);
	yorn_abort;
}


#------------------------------------------------------------------
#		Main
#------------------------------------------------------------------

my $help;
my $FORCE;
my $DRYRUN;
my ($reason, $project, $unit, $mode, $amount);
my $cluster;
my ($neg_slim, $neg_tlim, $neg_hbal, $neg_sbal, $neg_tbal);
my ($fake_std_usage, $fake_hi_usage);
my $querymode;

my $res = GetOptions(
	'help!' => \$help,
	'force!' => \$FORCE,
	'dryrun!' => \$DRYRUN,
	'querymode!' => \$querymode,

	'reason=s' => \$reason,
	'project=s' => \$project,
	'unit=s' => \$unit,
	'mode=s' => \$mode,
	'amount=f' => \$amount,

	'allow_neg_std_limit|allow-neg-std-limit!' => \$neg_slim,
	'allow_neg_tot_limit|allow-neg-std-limit!' => \$neg_tlim,
	'allow_neg_high_balance|allow-neg-high-balance!' => \$neg_hbal,
	'allow_neg_std_balance|allow-neg-std-balance!' => \$neg_sbal,
	'allow_neg_tot_balance|allow-neg-tot-balance!' => \$neg_tbal,

	'fake-std-usage|fake_std_usage=f' => \$fake_std_usage,
	'fake-high-usage|fake_high_usage=f' => \$fake_hi_usage,
);

unless ($res)
{	usage;
	die "\nError parsing options.\n";
}

if ( $help )
{	usage;
	exit 0;
}

unless ( $project )
{	usage;
	die "\nMissing required parameter 'project'.\n";
}

unless ( defined $amount )
{	usage;
	die "\nMissing required parameter 'amount'.\n";
}

unless ( $reason )
{	usage;
	die "\nMissing required parameter 'reason'.\n";
}

unless ( $unit )
{	usage;
	die "\nMissing required parameter 'unit'.\n";
}
my $tmp = lc $unit;
unless ( $tmp eq 'ksu' || $tmp eq 'su' || $tmp eq 'cpumin' )
{	usage;
	die "\nIllegal value '$unit' for 'unit', expecting kSU, SU, or CPUmin.\n";
}
$unit = $tmp;


unless ( $mode )
{	usage;
	die "\nMissing required parameter 'mode'.\n";
}
$tmp = lc $mode;
unless ( $tmp eq 'set' || $tmp eq 'add' || $tmp eq 'sub' )
{	usage;
	die "\nIllegal value '$mode' for 'mode', expecting set, add, or sub.\n";
}
$mode = $tmp;


my $hpc = Glue::HPCC::Cluster->new_from_clustername($cluster);
$cluster = $hpc->db_clustername;
$hpc->dryrun($DRYRUN);
my $slrmproj = 'Glue::HPCC::ClusterUtil::Slurm::Project';
my $sacctmgr = $slrmproj->sacctmgr;
$sacctmgr->dryrun($DRYRUN);
my $sshare = $slrmproj->sshare;

#Get project quarterly alloc, and verify is co-op
my $proj = $GHPProj->project_by_name( $hpc, $project);
die "Unrecognized project $project at " unless $proj;
die "Error looking up project $project: $proj at "
	unless ref($proj);

my $ptid = $proj->projtype;
my $ptype = $GHPPType->projecttype_by_pkey($hpc, $ptid);
die "Could not find project type pkey=$ptid at "
	unless $ptype;
die "Error looking up ptype for $project ($ptid): $ptype at "
	unless ref($ptype);
my $ptname = $ptype->name;

die "Project $project is type $ptname, not coop at "
	unless $ptname eq 'coop';

my $cur_qsu = $proj->su;

#Calculate new_qsu (quarterly su's)
#	First, Convert amount to su
my $amtsu;
if ( $unit eq 'ksu' )
{	$amtsu = $amount * 1000;
} elsif ( $unit eq 'su' )
{	$amtsu = $amount;
} elsif ( $unit eq 'cpumin' )
{	$amtsu = $amount/60;
} else
{	die "Unrecognized unit '$unit' at ";
}

my $new_qsu;
if ( $mode eq 'set' )
{	$new_qsu = $amtsu;
} elsif ( $mode eq 'add' )
{	$new_qsu = $cur_qsu + $amtsu;
} elsif ( $mode eq 'sub' )
{	$new_qsu = $cur_qsu - $amtsu;
} else
{	die "Unrecognized mode '$mode' at ";
}

my $flags = {};
$flags->{'stdlim<0'} = 1 if $neg_slim;
$flags->{'totlim<0'} = 1 if $neg_tlim;
$flags->{'hibal<0'} = 1 if $neg_hbal;
$flags->{'stdbal<0'} = 1 if $neg_sbal;
$flags->{'totbal<0'} = 1 if $neg_tbal;
$flags->{'fake_std_cpumin_used'} = $fake_std_usage*1000*60 
	if defined $fake_std_usage;
$flags->{'fake_high_cpumin_used'} = $fake_hi_usage*1000*60 
	if defined $fake_hi_usage;


#Verify that looks reasonable 
my $results;
$flags->{dryrun} = 1;

while(1)
{	
	$results = slurm_modify_coop_balances(
		slrmproj => $slrmproj,
		hpc => $hpc,
		project => $project,
		reason => $reason,
		newSU => $new_qsu,
		flags => $flags,
		);

	my $eflag = $results->{errorflag};
	last if $eflag eq 'dryrun';
	my $etext = $results->{errortext} || 'Unknown error';

	if ( $eflag eq 'unknown' )
	{	use Data::Dumper;
		print STDERR Dumper($results);
		print STDERR "\n\n======================\n\n";
		die "Fatal error:\n$etext\n";
	}


	#OK, we got a warning about limit or balance going negative.
	#Warn user and see if they want to continue.
	my $new_flag = "ignore_${eflag}";
	warn_or_abort($etext);
	#Didn't abort, so try again
	$flags->{$new_flag} = 1;
}

if ( $querymode )
{	print STDERR <<EOF;
-------------------------------------------
		Query mode
-------------------------------------------

The following actions would have been performed:

EOF
	dump_results($project, $cluster, $results);

	print STDERR "\nExiting.\n";
	exit 0;
}

confirm_action($project, $cluster, $results) unless $FORCE;

#Actually do it
delete $flags->{dryrun}; #We still honor $DRYRUN via $sacctmgr, etc.
$results = slurm_modify_coop_balances(
	slrmproj => $slrmproj,
	hpc => $hpc,
	project => $project,
	reason => $reason,
	newSU => $new_qsu,
	flags => $flags,
);

my $eflag = $results->{errorflag};
if ( $eflag )
{	my $etext = $results->{errortext};
	die <<EOF;
Error updating project:
flag=$eflag
text=$etext

Aborting.
EOF
}

print STDERR <<EOF;
--------------------------------------------------------
		Summary of what did
--------------------------------------------------------

EOF

dump_results($project, $cluster, $results);
