#!/usr/local/bin/perl
#
#Modifies PDB entry for a project
#

use strict;
use warnings;
use lib '/cell_root/software/HPCC/lib/site_perl';
#use lib '/afs/.glue.umd.edu/software/HPCC/1.1/lib/site_perl';

use Glue::HPCC::Cluster;
use Glue::HPCC::Project::Person;
use Glue::HPCC::Project::PersonProject;
use Glue::HPCC::Project::Project;
use Glue::HPCC::Project::ProjectType;
use Glue::HPCC::Project::Log;
use Glue::HPCC::Project::Department;

use Getopt::Long;
use Time::ParseDate;
use POSIX qw(strftime);

my $FORCE;

sub usage()
{	print STDERR <<EOF;
$0: Modifies entries for project in projects Database (PDB)

Usage:
The following are PDB-only activities:
$0 -project PROJ -group NEWGROUP -reason REASON
$0 -project PROJ -parent PARENT_PROJ -reason REASON
$0 -project PROJ -dept DEPTCODE -reason REASON
$0 -project PROJ -expire EXPIRATION -reason REASON
$0 -project PROJ -over_threshold THRHLD_OVER -reason REASON
$0 -project PROJ -under_threshold THRHLD_UNDER -reason REASON

The following only do PDB modification, and typically require
additional work on the scheduler side to really do what you want.
$0 -project PROJ --[no]active -reason REASON
$0 -project PROJ -type TYPE -reason REASON
$0 -project PROJ -unit (ksu|-su|-min) -set AMOUNT -reason REASON
$0 -project PROJ -unit (ksu|-su|-min) -add AMOUNT -reason REASON
$0 -project PROJ -unit (ksu|-su|-min) -sub AMOUNT -reason REASON
$0 -project PROJ -DELETE -reason REASON

For all of the above, can optionally give --cluster CLUSTER to
determine which DB to connect to.  CLUSTER defaults based on the
host the command is run on.

This script ONLY modifies the projects entry in the PDB.  For the
first set of commands above, that is sufficient.  For the second
set, the actions require both PDB and scheduler/etc work to be 
done.  This script only supplies the second set of commands for
doing manual repair of problems with the PDB.

All modifications will be logged and require a REASON.

-group option will change the unix group associated with the project.
-parent option will change the parent project for the project to the
	specified project (by name).  Set it to 'NULL' to have no parent.
-dept option will set the department for project to specified dept code.
-expire will change the expiration date for the project
-over_threshold/-under_threshold set the thresholds (in percentage
	points) for warnings about over/under usage of allocation.
	Set < 0 to set to NULL (i.e. to hard-coded system defaults)

--noactive will deactivate/disable the project; --active activates/enables
it.  This only affects the PDB; you need to do more stuff to actually
disable/enable in the scheduler.

-set, -add, or -sub will affect the funding for the project.  They are
mutually exclusive.  You must give an -unit (ksu, su or min) and the amount.
The su field in table will be set to that amount, incremented by that
amount, or decremented by that amount, resp.
NOTE: This does NOT directly affect balances as seen by sacctmgr, etc.

-type changes the project type for that cluster.  Again, this acts on the PDB
only, likely you will need to modify a bunch of stuff in Slurm as well.

--DELETE will delete the row from the project table.  This should be used
sparingly.

EOF
}

sub to_su($$)
#Convert value in cpumin, su, or ksu to su.
{	my $value = shift;
	my $unit = shift;
	die "Must supply an unit at " unless $unit;
	$unit = lc $unit;

	return $value if ( $unit eq 'su' );
	return 1000*$value if ( $unit eq 'ksu' );
	return $value/60 if $unit eq 'min';

	die "Illegal unit $unit, not recognized, at ";
}

sub warn_pdb_only_change($$$$)
#WArns user re changes to PDB only when action requires 
#other changes
{	my $projname = shift;
	my $field = shift;
	my $oldval = shift;
	my $newval = shift;

	return if $FORCE;
	print STDERR <<EOF;
You have requested the following modification to the
project $projname:
Change $field from $oldval to $newval

This action normally requires changes in both PDB and
in the scheduler or other places.

This code ONLY changes the PDB, and so should not be
used to do this in general project maintenance.  This
code allows such changes only to facilitate fixes 
requiring such ugly manual intervention.

If you are sure you wish to continue with this, type
'yes' below, otherwise control-c to abort.

Continue?
EOF

	my $ans = <STDIN>;
	chomp $ans;
	return if $ans =~ /^\s*y(es)?\s*$/i;
	die "Aborting at user request.  Any changes to PDB rolled back.\n";
}

sub warn_pdb_only_delete($)
#WArns user re changes to PDB only when deletijng project
{	my $projname = shift;

	return if $FORCE;
	print STDERR <<EOF;
You have requested to DELETE the data in PDB for 
project $projname:

It is generally advised to just disable projects,
and even that requires more than just PDB changes.

This code ONLY changes the PDB, and so should not be
used to do this in general project maintenance.  This
code allows such changes only to facilitate fixes 
requiring such ugly manual intervention.

If you are sure you wish to continue with this, type
'yes' below, otherwise control-c to abort.

Continue?
EOF

	my $ans = <STDIN>;
	chomp $ans;
	return if $ans=~/^\s*y(es)?\s*$/i;
	die "Aborting at user request.  Any changes to PDB rolled back.\n";
}

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

my ($help, $dryrun, $verbose);
my ($cluster, $project, $reason);
my ($unixgrp, $exp, $parentname, $deptcode);
my ($over, $under);

my ($unit, $set, $add, $sub);
my ( $type, $active, $DELETE);

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

	'cluster=s' => \$cluster,
	'project=s' => \$project,
	'reason=s' => \$reason,

	'group=s' => \$unixgrp,
	'parent=s' => \$parentname,
	'department|dept=s' => \$deptcode,
	'expiration|expire=s' => \$exp,
	'over-threshold|over_threshold=f' => \$over,
	'under-threshold|under_threshold=f' => \$under,

	'active!' => \$active,
	'type=s' => \$type,
	'unit=s' => \$unit,
	'set=f' => \$set,
	'add=f' => \$add,
	'subtract=f' => \$sub,
	'DELETE' => \$DELETE,
);

unless ( $res )
{	usage;
	die "\nError processing arguments\n";
}

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

my $tmp;

if (scalar(@ARGV) )
{	usage;
	$tmp = join ', ', @ARGV;
	die "\nUnrecognized arguments: [ $tmp ], aborting\n";
}

#Default cluster if needed
my $hpc = Glue::HPCC::Cluster->new_from_clustername($cluster);
die "\nInvalid cluster $cluster at " if $cluster && ! $hpc && ! ref($hpc);
die "\nError instantiating cluster $hpc " unless $hpc && ref($hpc);
$cluster = $hpc->db_clustername;

$hpc->verbose($verbose);
$hpc->dryrun($dryrun);

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

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

my $did_something = 0;
my $error;
my ($tstamp, $date);

my $proj = Glue::HPCC::Project::Project->project_by_name($hpc, $project);
die "Illegal value $project for project, not found in PDB.\n" unless ( $proj );
die "Error looking up $project in PDB: $proj.\n" unless ref($proj);

my $oldval;
my @tmp;

if ( $DELETE )
{	die "--DELETE is incompatible with --group, --parent, or --dept flags.\n"
		if $unixgrp || $parentname || $deptcode;
	die "--DELETE is incompatible with --expiration, -over-threshold, -under-threshold flags.\n"
		if $exp || defined $over || defined $under;
	die "--DELETE is incompatible with --active or --type flags.\n"
		if $type || defined $active;
	die "--DELETE is incompatible with --unit, --set, --add, or --sub flags.\n"
		if $unit || $add || $sub || $set;

	warn_pdb_only_delete($project);

	#Must have NO records in person_project table for us
	$tmp = Glue::HPCC::Project::PersonProject->get_project_persons_by_projectname(
		$hpc, $project);
	die "Error looking up membership of project $project in PDB: $tmp\n"
		if $tmp && ! ref($tmp);
	if ( $tmp && scalar(@$tmp) )
	{ 	@tmp = map { Glue::HPCC::Project::Person->person_by_pkey($hpc, $_->ppl_pkey)}
			@$tmp;
		@tmp = map { $_->username } @tmp;
		$tmp = join ", ", @tmp;
		die <<EOF;
Unable to delete a project with any associated users.
The following users are associated with $project:
	$tmp
If you wish to delete the project, delete the associations of
these users with this project.

EOF
	}

	my $prj_pkey = $proj->prj_pkey;

	#Must have no projects with us as a parent
	$tmp = Glue::HPCC::Project::Project->pdb_query($hpc,
		parent => $prj_pkey );
	die "Error looking up children of project $project in PDB: $tmp\n"
		if $tmp && ! ref($tmp);
	if ( $tmp && scalar(@$tmp) )
	{ 	@tmp = map { Glue::HPCC::Project::Project->project_by_pkey($hpc, $_->prj_pkey)}
			@$tmp;
		@tmp = map { $_->name } @tmp;
		$tmp = join ", ", @tmp;
		die <<EOF;
Unable to delete a project with any child projects.
The following projects are children of project  $project:
	$tmp
If you wish to delete project $project, you must disinherit
these child projects from it.

EOF
	}
	

	Glue::HPCC::Project::Project->pdb_delete($hpc,
		prj_pkey=>$prj_pkey);
	Glue::HPCC::Project::Log->add_log_entry($hpc,
		project => $project,
		tablename => 'project',
		reason => $reason,
		description => "Delete row for project $project",
		action_code => 'delete-row',
	);
	print "Deleted row for project $project.\n";
	$hpc->db_commit;
	print "DB committed.\n";
	exit 0;
}
	
if ( $unixgrp )
{	$oldval = $proj->unixgroup;
	if ( $unixgrp eq $oldval)
	{	warn "Project $project: Unix group already set to $unixgrp, nothing to do.\n";
	} else
	{	$error = $proj->pdb_update_me($hpc, unixgroup => $unixgrp);
		die "Error setting unixgroup to $unixgrp for $project: $error\n" .
			"Rolling back transaction.\n" if $error;
		print "Set unixgroup=$unixgrp for project $project\n";
		$did_something=1;
                Glue::HPCC::Project::Log->add_log_entry($hpc,
                        project => $project,
                        tablename => 'project',
                        fieldname => 'unixgroup',
                        oldval => $oldval,
                        newval => $unixgrp,
                        reason => $reason,
                        description => "Change unix group for $project",
			action_code => 'modify-project',
                );
	}
}

if ( $parentname )
{	$oldval = $proj->parent;
	my $parentid = undef;
	if ( $parentname )
	{	my $parent = Glue::HPCC::Project::Project->project_by_name(
			$hpc, $parentname);
		die "Invalid parent '$parentname', not found in PDB.\n" .
			"Rolling back transaction.\n" unless $parent;
		die "Error looking up parent $parentname in PDB, $parent\n" .
			"Rolling back transaction.\n" unless ref($parent);
		$parentid = $parent->prj_pkey;
	}

	$tmp = 1;
	$tmp = 0 if ! defined $oldval && ! defined $parentid;
	$tmp = 0 if defined $oldval && defined $parentid && $oldval == $parentid;
	if ( $tmp )
	{	$error = $proj->pdb_update_me($hpc, parent => $parentid);
		die "Error setting parent to $parentname ($parentid) " .
			"for $project: $error\nRolling back transaction.\n" if $error;
		print "Set parent=$parentname ($parentid) for project $project\n";
		$did_something=1;
                Glue::HPCC::Project::Log->add_log_entry($hpc,
                        project => $project,
                        tablename => 'project',
                        fieldname => 'parent',
                        oldval => $oldval,
                        newval => $parentid,
                        reason => $reason,
                        description => "Change parent for $project to $parentname",
			action_code => 'modify-project',
                );
	}
} 

if ( $deptcode )
{	$oldval = $proj->department;
	my $dept = Glue::HPCC::Project::Department->dept_by_code(
		$hpc, $deptcode);
	die "Illegal dept $deptcode for project $project, not in PDB.\n" .
		"Rolling back transaction.\n" unless $dept;
	die "Error looking up dept code=$deptcode, $dept.\n" .
		"Rolling back transaction.\n" unless ref($dept);
	my $deptid = $dept->dept_pkey;

	if ( $deptid eq $oldval)
	{	warn "Project $project: department already set to $deptcode, nothing to do.\n";
	} else
	{	$error = $proj->pdb_update_me($hpc, department => $deptid);
		die "Error setting department to $deptcode for $project: $error\n" .
			"Rolling back transaction.\n" if $error;
		print "Set dept=$deptcode ($deptid)  for project $project\n";
		$did_something=1;
                Glue::HPCC::Project::Log->add_log_entry($hpc,
                        project => $project,
                        tablename => 'project',
                        fieldname => 'department',
                        oldval => $oldval,
                        newval => $deptid,
                        reason => $reason,
                        description => "Change department for $project to $deptcode",
			action_code => 'modify-project',
                );
	}
}

if ( defined $over )
{	$oldval = $proj->thrhld_pct_over;
	$over = undef if $over < 0;
	$tmp = 1;
	$tmp = 0 if ! defined $oldval && ! defined $over;
	$tmp = 0 if defined $oldval && defined $over && $oldval == $over;

	if ( $tmp )
	{	$error = $proj->pdb_update_me($hpc, 
			thrhld_pct_over => $over);
		die "Error setting thrhld_pct_over to $over " .
			"for $project: $error\n"   .
			"Rolling back transaction.\n" if $error;
		print "Set thrhld_pct_over=$over for project $project\n";
		$did_something=1;
                Glue::HPCC::Project::Log->add_log_entry($hpc,
                        project => $project,
                        tablename => 'project',
                        fieldname => 'thrhld_pct_over',
                        oldval => $oldval,
                        newval => $over,
                        reason => $reason,
                        description => "Change over usage threshold for $project",
			action_code => 'modify-project',
                );
	} else
	{	$tmp = $over;
		$tmp = 'NULL (system default)' unless defined $tmp;
		warn "Project $project: thrhld_pct_over already set to $tmp, nothing to do.\n";
	}
}

if ( defined $under )
{	$oldval = $proj->thrhld_pct_under;
	$under = undef if $under < 0;
	$tmp = 1;
	$tmp = 0 if ! defined $oldval && ! defined $under;
	$tmp = 0 if defined $oldval && defined $under && $oldval == $under;

	if ( $tmp )
	{	$error = $proj->pdb_update_me($hpc, 
			thrhld_pct_under => $under);
		die "Error setting thrhld_pct_under to $under " .
			"for $project: $error\n"  .
			"Rolling back transaction.\n" if $error;
		print "Set thrhld_pct_under=$under for project $project\n";
		$did_something=1;
                Glue::HPCC::Project::Log->add_log_entry($hpc,
                        project => $project,
                        tablename => 'project',
                        fieldname => 'thrhld_pct_under',
                        oldval => $oldval,
                        newval => $under,
                        reason => $reason,
                        description => "Change under usage threshold for $project",
			action_code => 'modify-project',
                );
	} else
	{	$tmp = $under;
		$tmp = 'NULL (system default)' unless defined $tmp;
		warn "Project $project: thrhld_pct_under already set to $tmp, nothing to do.\n";
	}
}

if ( $exp )
{	$tstamp = parsedate($exp);
	unless ( defined $tstamp )
	{	die "Illegal value '$exp' for project expiration, cannot " .
			"parse as date.\n" .
			"Rolling back transaction.\n";
	}
	$date = strftime("%Y-%m-%d %H:%M:%S", localtime($tstamp));
	$oldval = $proj->expiration;
	if ( $date eq $oldval )
	{	warn "Project $project: expiration already set to " .
			"$date, nothing to do.\n";
	} else
	{	$error = $proj->pdb_update_me($hpc, expiration => $date);
		die "Error setting proj exp to $date for $project: $error\n" .
			"Rolling back transaction.\n" if $error;
		print "Set project expiration=$date for project $project\n";
		$did_something=1;
                Glue::HPCC::Project::Log->add_log_entry($hpc,
                        project => $project,
                        tablename => 'project',
                        fieldname => 'expiration',
                        oldval => $oldval,
                        newval => $date,
                        reason => $reason,
                        description => "Change expiration for $project",
			action_code => 'modify-project',
                );
	}
}

if ( $type )
{	my $ptype = 
		Glue::HPCC::Project::ProjectType->projecttype_by_name(
			$hpc, $type);
	die "Invalid project type '$type': not found in PDB.\n" .
		"Rolling back transaction.\n" unless $ptype;
	die "Error looking up proj type '$type': $ptype.\n" .
		"Rolling back transaction.\n" unless ref($ptype);
	my $typeid = $ptype->pkey;

	$oldval = $proj->projtype;
	if ( $oldval == $typeid )
	{	warn "Project $project: type is already $type, nothing"
			. " to do.\n";
	} else
	{	$ptype = 
		  Glue::HPCC::Project::ProjectType->projecttype_by_pkey(
			$hpc, $oldval);
		die "Invalid existing type " . $oldval . 
			" for project $project: not found.\n" .
			"Rolling back transaction.\n" unless $ptype;
		die "Error looking up existing ptype $oldval: $ptype\n"  .
			"Rolling back transaction.\n" unless ref($ptype);
		$ptype = $ptype->name;

		warn_pdb_only_change($project, 'project type', $ptype, $type);

		$error=$proj->pdb_update_me($hpc, projtype=>$typeid);
		die "Error changing ptype for $project to $type(" .
			"$typeid): $error\n" .
			"Rolling back transaction.\n" if $error;
		print "Changed projtype for $project to $type($typeid)"
			. " (was $ptype)\n";
		$did_something=1;
		Glue::HPCC::Project::Log->add_log_entry($hpc,
			project => $project,
			cluster => $cluster,
			tablename => 'project',
			fieldname => 'projtype',
			oldval => $oldval,
			newval => $typeid,
			reason => $reason,
			description => "Change projtype for $project to $type",
			action_code => 'modify-project',
		);
	}
}

if ( defined $active )
{	$oldval = $proj->active;
	$oldval = $oldval?1:0;
	$active = $active?1:0;
	$tmp = 'disabled';
	$tmp = 'enabled' if $active;
	my $negtmp = 'disabled';
	$negtmp = 'enabled' if $oldval;
	if ( $oldval == $active )
	{	warn "Project $project: is already $tmp, nothing"
			. " to do.\n";
	} else
	{	warn_pdb_only_change($project, 'active status', $negtmp, $tmp);
		unless ( $active )
		{	#If disabling, should have no members
			$tmp = Glue::HPCC::Project::PersonProject->get_project_persons_by_projectname(
				$hpc, $project);
			die "Error looking up membership of $project: $tmp.\n" .
				"Rolling back changes.\n" if $tmp && ! ref($tmp);
			$tmp = [] unless $tmp;
			@tmp = grep { $_->is_member } @$tmp;
			@tmp = map { Glue::HPCC::Project::Person->person_by_pkey(
					$hpc, $_->ppl_pkey) } @tmp;
			@tmp = grep { $_->active } @tmp;
			@tmp = map { $_->username } @tmp;
			$tmp = join ", ", @tmp;
			die "Unable to disable project $project, still has members.\n" .
				"Members are [ $tmp ]\n.  Rolling back changes.\n"
				if scalar(@tmp);
		}

		$error=$proj->pdb_update_me($hpc, active=>$active);
		die "Error changing active for $project from $negtmp to $tmp: " .
			"$error\nRolling back transaction.\n" if $error;
		print "Changed active status for $project from $negtmp to $tmp\n";
		$did_something=1;
		Glue::HPCC::Project::Log->add_log_entry($hpc,
			project => $project,
			cluster => $cluster,
			tablename => 'project',
			fieldname => 'active',
			oldval => $oldval,
			newval => $active,
			reason => $reason,
			description => "$tmp project $project",
			action_code => 'modify-project',
		);
	}
}

if ( defined $set || defined $add || defined $sub )
{	#Only one allowed
	$tmp = 0;
	$tmp++ if defined $set;
	$tmp++ if defined $add;
	$tmp++ if defined $sub;
	die "Only one of -set, -add, or -sub is allowed.\n"  .
		"Rolling back transaction.\n"
		if $tmp > 1;
	die "You must provide an -unit if using -set, -add, or -sub.\n" .
		"Rolling back transaction.\n"
		unless $unit;
	my ($amt);
	$oldval = $proj->su;
	if ( defined $set )
	{	$amt = to_su($set, $unit);
		$tmp = "set to $set $unit";
	} elsif ( defined $add )
	{	$amt = $oldval + to_su($add, $unit);
		$tmp = "add $add $unit";
	} elsif ( defined $sub )
	{	$amt = $oldval - to_su($sub, $unit);
		$tmp = "sub $sub $unit";
	} else
	{	die "Should not reach here at ";
	}

	if ( $oldval == $amt )
	{	warn "Project $project already at $amt SU,"
			. " nothing to do.\n" if defined $set;
		warn "Pointless to add/sub 0 from project, nothing to do.\n"
			if defined $add || defined $sub;
	} else
	{	$error = $proj->pdb_update_me($hpc, su=>$amt);
		die "Error setting SU for $project to $amt ($tmp): "
			. "$error\nRolling back transaction\n" 
			if $error;
		print "Changed SU for $project to $amt (was $oldval)\n";
		$did_something=1;
		Glue::HPCC::Project::Log->add_log_entry($hpc,
			project => $project,
			cluster => $cluster,
			tablename => 'project',
			fieldname => 'su',
			oldval => $oldval,
			newval => $amt,
			reason => $reason,
			description => "Change ksu for $project ($tmp)",
			action_code => 'modify-project',
			);
	}
}

if ( $did_something)
{	print "Committing PDB.\n";
	$hpc->db_commit;
} else
{	warn "Nothing to do.\n";
}

