#!/usr/local/bin/perl
#
#Create a new project for specified HPCC cluster
#Either a brand new project (doesn't exist in any cluster)
#

use strict;
use warnings;
use lib '/cell_root/software/HPCC/lib/site_perl';
#For testing, use RW replica
#use lib '/afs/.glue.umd.edu/software/HPCC/1.1/lib/site_perl';

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

use Slurm::Sacctmgr;
use Slurm::Sacctmgr::Account;

use Glue::HPCC::Utils::MailUtils qw(send_template_email);
use Glue::HPCC::Utils::UnixGroup qw(unix_group_exists);

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

my @cc_everything = ( ); #Have this in the template file now
my $cclist = join ", ", @cc_everything;

sub usage_short()
{	print STDERR <<EOF;
$0: create a project 

Usage:
$0 [ -cluster CLUSTER ] -project PROJNAME -type PROJTYPE \
	-ksu KSU  -dept DEPTCODE -reason REASON -poc POCUNAME \
	[ -parent PARENT_NAME ] [ --carve-from HOSTPROJ ] \
	[ -group UNIXGROUP ] [ -[no]add-poc-as-member ] \
	[ -full POCFULL ] [ -email POCEMAIL ] [ -uid POCUID ]\
	[ -exp EXP ] [ -desc DESC ] \
	[ --FIXME ] [ --force ] [ -[no]mail ]

Creates a new project.  CLUSTER defaults based on host command
is running on.  PROJNAME, PROJTYPE, DEPTCODE, REASON, and
POCUNAME are required.  KSU is required for real (i.e. not
organizational unit/container-only) projects.

$0 --help prints longer help text.

EOF
}

sub usage_long()
{	usage_short;
	print STDERR <<EOF;

Every project must belong to a dept, given by the 4 letter code DEPTCODE.

Every project requires a point of contact given by the username  POCUNAME.
POCFULL, POCEMAIL, and POCUID will be defaulted from Hesiod, etc., but
can be overridden.

Reason is the reason the project being added; typically an ITSC number or
reference to a AAC request.

kSU is value of the allocation.  This is ALWAYS after-tax values.
For co-op projects, this should be the quarterly allocation. 
For grants, the total allocation.  Can be omitted for condo or ou projects.

A project can have a parent, in which case give name of parent in 
PARENT_NAME.  To "carve" a project from another project's ksu, give the
donating project's name in HOSTPROJ.  HOSTPROJ must either be the parent
of the new project, or the two must share a parent.

If --add-poc-as-member is set (default), the script will automatically
add POCUNAME as a member of the newly created project, unless it is
a container only (no-member) project type..  Use --noadd-poc-as-member 
if that is not desired.

If FIXME is set, will not abort on partially created projects but attempt to
repair them.  If --force given, do not prompt for confirmation.

Email is sent to PoC by default (unless we are a memberless/container-only/
ou project type); use --nomail to disable.

EOF
}

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

my ($help, $dryrun, $verbose);
my ($cluster, $project, $type, $ksu);
my ($unixgrp, $reason, $desc);
my ($poc, $full, $email, $uid);
my ($exp, $parentname, $deptcode, $carvefrom);
my ($tmp, $where, $set, $error, $poclist, $prjid, $clid);
my @tmp;
my $FIXME;
my $force;
my $do_mail=1;
my $addpoc = 1;

my $res = GetOptions(
	'help!' => \$help,
	'dryrun!' => \$dryrun,
	'verbose!' => \$verbose,
	'FIXME!' => \$FIXME,
	'force!' => \$force,
	'mail!' => \$do_mail,
	'add-poc-as-member|add_poc_as_member|addpoc!'
		=> \$addpoc,

	'cluster=s' => \$cluster,
	'p|prj|proj|project=s' => \$project,
	'type=s' => \$type,
	'ksu=f' => \$ksu,
	'group=s' => \$unixgrp,
	'description=s' => \$desc,
	'reason=s' => \$reason,
	'poc=s' => \$poc,
	'full=s' => \$full,
	'email=s' => \$email,
	'uid=i' => \$uid,
	'expiration=s' => \$exp,
	'department|dept=s' => \$deptcode,
	'parent=s' => \$parentname,
	'carve-from|carve_from=s' => \$carvefrom,
);

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

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

if (scalar(@ARGV) )
{	usage_short;
	$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);
Glue::HPCC::Utils::MailUtils::verbose($verbose);
Glue::HPCC::Utils::MailUtils::dryrun($dryrun);
Glue::HPCC::ClusterUtil->dryrun($dryrun);

unless ($project)
{	usage_short;
	die "\nMissing required parameter 'project'\n";
}
unless ( $project =~ /^[a-z][-a-z0-9]{2,15}$/i )
{	usage_short;
	die "\nInvalid project name: Want 3-16 characters, letters/digits/-\n";
}
my $lcproject = lc $project;

unless ( $type )
{	usage_short;
	die "\nMissing required parameter 'type'\n";
}
my $typerec = Glue::HPCC::Project::ProjectType->projecttype_by_name($hpc,$type);
unless ( $typerec )
{	$tmp = Glue::HPCC::Project::ProjectType->project_types;
	$tmp = join "\n\t", @$tmp;
	die "Illegal value $type for project type; expecting one of:\n\t$tmp\n";
}
$type = $typerec->name;
unless ( $typerec->can_have_members )
{	$addpoc = 0;
	$do_mail = 0;
}

unless ( $deptcode )
{	usage_short;
	die "\nMissing required parameter 'dept'\n";
}
my $dept = Glue::HPCC::Project::Department->dept_by_code($hpc, $deptcode);
unless ( $dept )
{	usage_short;
	die "\nIllegal deptcode $deptcode, not in PDB.\n";
}
die "Error looking up deptcode $deptcode: $dept at " unless ref($dept);
my $deptid = $dept->dept_pkey;
my $collid = $dept->college;
my $coll = Glue::HPCC::Project::College->college_by_pkey($hpc, $collid);
my $college = $coll->code;

if ( $ksu )
{ 	unless ( $ksu =~ /^\s*\d+(\.\d*)?\s*$/ )
	{	usage_short;
		die "\nInvalid ksu '$ksu', does not look like a number.\n";
	}
} else
{	#No ksu given.  This is only OK for unmetered (e.g. condo or ou types)
	if ( $typerec->is_metered )
	{	usage_short;
		die "Parameter 'ksu' is required for project type '$type'\n";
	}
}

my $parentid;
if ( $parentname )
{	my $parent = Glue::HPCC::Project::Project->project_by_name(
		$hpc, $parentname);
	unless ( $parent )
	{	usage_short;
		die "\nParent project $parentname not found in PDB.\n";
	}
	die "Error looking up parent project $parentname: $parent at "
		unless ref($parent);
	$parentid = $parent->prj_pkey;
}

my $carveid;
if ( $carvefrom )
{	my $carveproj = Glue::HPCC::Project::Project->project_by_name(
		$hpc, $carvefrom);
	unless ( $carveproj)
	{	usage_short;
		die "\nCarve-from project $carvefrom not found in PDB.\n";
	}
	die "Error looking up project $carvefrom: $carveproj at "
		unless ref($carveproj);
	$carveid = $carveproj->prj_pkey;

	#Some additional validation
	#stupid to carve from if no ksu
	unless ( defined $ksu )
	{	usage_short;
		die "\nDoesn't make sense to carve-from w/out ksu.\n";
	}	

	#carvefrom must either be our parent, or have the same parent as us
	unless ( defined $parentid )
	{	usage_short;
		die "\nMust specify the parent of the new project when using -carve-from.\n";
	}
	my $carveparent = $carveproj->parent;
	unless ( ($carveid == $parentid) || 
		(defined $carveparent && $carveparent == $parentid) )
	{	usage_short;
		my $cpar = '*none*';
		if ( defined $carveparent )
		{	$cpar = Glue::HPCC::Project::Project->project_by_pkey(
				$hpc, $carveparent);
			$cpar = $cpar->name;
		}
		die <<EOF;

When carving from $carvefrom, parent of new project must either be:
	$carvefrom
or 
	the parent of $carvefrom ($cpar)

EOF
	}

	#Carvefrom account must have at least as much funds in it as we
	#wish to remove
	my $cksu = ( $carveproj->su || 0 ) /1000;
	unless ( $ksu > $cksu )
	{	usage_short;
		$tmp = sprintf "%0.3 kSU", $cksu;
		die "\nProject $carvefrom only has $tmp, " .
			"cannot carve $ksu kSU from it at ";
	}	

	
	die "\n\n\nSorry, carve-from option not implemented yet.\n\n\n";
}


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

if ( $exp )
{	$tmp = parsedate($exp);
	die "Illegal value '$exp' for --expiration, cannot parse "
		. "as date.\n" unless defined $tmp;
	$exp = strftime("%Y-%m-%d %H:%M:%S", localtime($tmp));
} else
{	#Default exp
	my $now = time;
	my $defdays = $typerec->default_expiry_days;
	my $defsecs = 60*60*24*$defdays; #$defdays in seconds
	$exp = $now + $defsecs;
	$exp = strftime("%Y-%m-%d %H:%M:%S", localtime($exp));
}

die "Missing required parameter -poc for new project $project\n"
		unless $poc;

#See if project exists at all
my $proj = Glue::HPCC::Project::Project->project_by_name($hpc, $project);
die "Error looking up project $project: $proj\n" 
	if $proj && ! ref($proj);

if ( $proj )
{	#Project already exists in PDB
	if ( $proj->active )
	{ 	die <<EOF;
Project $project already exists and is active in PDB
Either delete it or rerun in FIXME mode.

Unfortunately, FIXME mode currently not working:(

EOF
	}
}

#Default other parms
if ( $typerec->requires_unix_group ) 
{   	$tmp = $hpc->unixgrp_prefix;
	$unixgrp = "${tmp}${lcproject}" unless ( $unixgrp );
}
$desc = "$project project" unless $desc;
$addpoc = $addpoc?1:0;

my $unixgid;
if ( $unixgrp && $hpc->scheduler_type ne 'dummy' )
{	$tmp = unix_group_exists($unixgrp);
	die "\nUnix group $unixgrp not found.\n" unless ( $tmp );
	my @tmp = split /:/, $tmp;
	$unixgid = $tmp[2];
}
	

#Confirm request
unless ( $force )
{	print STDERR <<EOF;
You are requesting the creation of the following project:
Project Name:	$project
Cluster:	$cluster
Department:	$deptcode ($deptid) [in college $college ($collid)]
Type of Proj:	$type
EOF
	print STDERR "Parent Project:	$parentname($parentid)\n" 
		if defined $parentid;
	print STDERR "Amount (kSU):	$ksu\n" if defined $ksu;
	print STDERR "Carve from proj: $carvefrom ($carveid)\n" 
		if defined $carveid;
	my $tmp2 = $unixgrp;
	$tmp2 = '<NULL>' unless defined $tmp2;
	$tmp = $addpoc?'(add as member)':'';
	print STDERR <<EOF;
Unix Group:	$tmp2
Description:	$desc
Expiration:	$exp
Reason:		$reason
Contact Person: $poc $tmp

Type 'yes' if this is correct and you wish to continue.
Otherwise, control-c out of this.
EOF
	my $ans;
	while ( 1 )
	{	$ans = <STDIN>;
		chomp $ans;
		last if  ($ans =~ /^\s*(y(es?)?|no?)\s*$/i );
		print STDERR "Enter 'yes' or 'no' ";
	}
	die "Aborting at user request.\n" 
		unless $ans =~ /^\s*y(es?)?\s*$/i;
}

#All validations passed, start creating stuff

my @fields;
my $hpcUtil = $hpc->get_hpcUtil;
my $userUtil = $hpcUtil->user;
my $projUtil = $hpcUtil->project;

#If POC given, create it if needed
if ( $poc )
{ 	@fields = ( hpc=>$hpc,
		username => $poc, reason => $reason);
	push @fields, fullname => $full if $full;
	push @fields, email => $email if $email;
	push @fields, uid => $uid if $uid;
	$error = $userUtil->add_or_update_person_to_pdb( @fields);
	die "\nError adding PoC $poc to PDB: $error at " if $error;
}

#Create project in PDB if needed (or update if not)
my @args = ( 
	hpc => $hpc,
	project => $project, 
	description => $desc,
	unixgroup => $unixgrp,
	department => $deptcode,
	type => $type,
	ksu => $ksu,
	poc => $poc,
	expiration => $exp,
	active => 1,
	reason => $reason,
 );
push @args, parent => $parentname if $parentname;
push @args, FIXME => $FIXME if $FIXME;

$error = $projUtil->create_project(@args);
die "\nError creating project [" .  (join ", ", @args) . "]: $error at "
	if $error;

#Commit after successfully creating project
$hpc->db_commit;

#Now send email

#See if we exist in PDB (should if not DRYRUN mode
$proj = Glue::HPCC::Project::Project->project_by_name($hpc, $project);
unless ( $proj && ref($proj) )
{	die "\nError: new project $project not in PDB at "
		unless $dryrun;
}

#Get all pocs for project (in case was already in PDB)
my $poc_emails;
$poc_emails = Glue::HPCC::Project::PersonProject->get_poc_emails_for_project(
                $hpc, $project) if $proj;
if ( $dryrun )
{	#DRyrun mode, we probably are NOT in the PDB
	if ( $poc_emails && ref($poc_emails) eq 'ARRAY' )
	{	#We have some poc_emails, add our poc if not there
		@tmp = grep { $_ eq $poc } @tmp;
		push @$poc_emails, $poc unless @tmp;
	} else
	{	#No poc_emails, probably no proj
		$poc_emails = [ $poc ];
	}
}
	
die "Cannot get poc emails at " unless ( $poc_emails && 
	ref($poc_emails) eq 'ARRAY' && scalar(@$poc_emails) );
my $poc_email_str = join ', ', @$poc_emails;

my $pocuser = Glue::HPCC::Project::Person->person_by_username($hpc, $poc);
if ( $pocuser && ref($pocuser) )
{	$full = $pocuser->fullname unless $full;
} else
{	$full = "Fullname for $poc" unless $full;
}

my $expdate = parsedate($exp);
$expdate = strftime("%e %b %Y", localtime($expdate));

my $macros = 
{	EMAIL => $poc_email_str,
	FULLNAME => $full,
	PROJECT => $project,
	AMOUNT => $ksu,
	EXPDATE => $expdate,
	CCLIST => $cclist,
	DEPT => $deptcode,
	COLLEGE => $college,
	PARENT => $parentname
};
my $template = "${cluster}_new_project_${type}.tmplate";
send_template_email($template, $macros) if $do_mail;

#TODO: Need to remove SUs from carvefrom project here

if ( $addpoc )
{	#Add poc as member of the project

	#First, make sure has a functioning HPC account
	@fields = (
		hpc => $hpc,
		user => $poc,
		reason => $reason,
	);
	push @fields, gid => $unixgid if defined $unixgid;
	$error = $userUtil->add_user_to_hpc_cluster(@fields);
	die "Error adding Poc $poc to HPC cluster as user: $error at "
		if $error;
	
	@fields = ( hpc => $hpc,
		    user => $poc,
		    project => $project,
		    reason => $reason,
	);
	#Pocs for condos always get highpriority flag 
	push @fields, ( highpriority => 1 ) if $type eq 'condo';
	my $defacct;
	my $accounts = [];
	if ( $typerec->has_normal_priority || $typerec->has_special_partition )
	{	$defacct = $project;
		push @$accounts, $defacct;
	}
	if ( $typerec->has_high_priority )
	{	$defacct = "${project}-hi";
		push @$accounts, $defacct;
	} 
	push @fields, defaultaccount => $defacct if $defacct;

	if ( $dryrun )
	{	print STDERR "[DRYRUN] would be adding poc as member of $project\n";
	} else
	{	
		$error = $userUtil->add_user_to_project_in_cluster(@fields);
		die "Error adding $poc as member to project $project: $error at "
			if $error;
	}

	#COmmit after adding poc
	$hpc->db_commit;


	$tmp = Glue::HPCC::Project::Person->person_by_username(
		$hpc, $poc);
	die "Error looking up user $poc in PDB: $tmp at "
		if $tmp && ! ref($tmp);
	unless ( $tmp )
	{	die "Error: cannot find user $poc in PDB after adding, at "
			unless $dryrun;
		#Dryrun mode, special case, fake stuff
		$email = $poc . '@umd.edu';
		$full = "fullname of $poc";
	} else
	{	$email = $tmp->email;
		$full  = $tmp->fullname;
		$defacct = $userUtil->get_default_account_for_user(
			hpc => $hpc, user => $poc );
	}

	#Send email
	$macros = {
		USERNAME => $poc,
		EMAIL => $email,
		FULLNAME => $full,
		PROJECT => $project,
		DEFACCOUNT => $defacct,
		ACCOUNTS => $accounts,
		CCLIST => $cclist,
		CLUSTER => $cluster,
	};
	$template = "${cluster}_welcome_new_user.tmplate";
	send_template_email($template, $macros) 
		if $do_mail && $hpc->scheduler_type ne 'dummy';
}
