#!/usr/local/bin/perl
#
#Delete/disable project in 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::ClusterUtil;
use Glue::HPCC::Project::Person;
use Glue::HPCC::Project::Project;
use Glue::HPCC::Project::PersonProject;
use Glue::HPCC::Project::ProjectType;
use Glue::HPCC::Project::Log;

#use Glue::HPCC::Utils::UserAccounts qw(user_exists);
#use Glue::HPCC::Utils::MailUtils qw(send_template_email);
#use Glue::HPCC::Utils::FileUtils qw(
#		archive_data_dir
#		archive_home_dir
#	);
#use Glue::HPCC::Utils::UserRevocationReasons;

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

#Globals
#my @cc_on_everything = ( 'payerle@umd.edu' );


sub usage()
{	
	print STDERR <<EOF;
$0: Delete/disable project

Usage:
$0 [ --dryrun ] [ --verbose ] [ --force ] \
	[ --delete-from-pdb ] \
	--reason REASON \
	--project PROJECT

This will delete the specified project(s) from the cluster.  Must
be run as root on one of the cluster nodes (needs to update scheduler).
By default, it will remove the project from the scheduler, and then
disable the project in the PDB.  If --delete-from-pdb is given, it
will delete the record of the project from the PDB.

REASON is required, and will be entered into the PDB logs.

The project to be deleted/disabled must NOT have any members associated
with it (active or inactive).  PoCs ARE permitted unless you are
attempting to delete the record (--delete-from-pdb).

Also, the project must NOT be the parent project of active projects.
To delete the record (--delete-from-pdb) it cannot even be the parent
of inactive projects.

EOF
}


sub yorn($;$)
#Display prompt and wait for yes/no answer.
#Second argument is the default (y or n)
#if undef, no default
#Returns 'y' or 'n'
#(if no default or illegal answer, will keep prompting)
{	my $prompt = shift;
	my $default = shift;
	
	my $defstr = "y/n";
	if ( $default )
	{	$default = lc $default;
		die "yorn: Illegal default '$default' at "
			unless $default eq 'y' || $default eq 'n';
		$defstr = "Y/n" if $default eq 'y';
		$defstr = "y/N" if $default eq 'n';
	}

	while(1)
	{	print STDERR "$prompt($defstr)? ";
		my $ans = <STDIN>;
		chomp $ans;
		return $default if $default && ! $ans;
		return 'y' if $ans=~ /^\s*y(es?)?\s*$/i;
		return 'n' if $ans=~ /^\s*no?\s*$/i;
		print STDERR "Please answer yes or no.\n";
	}
}
	
sub canonicalize_yes_no_prompt($;$$)
#Canonicalizes 'yes', 'no', 'prompt' options, e.g. for --delete-data
#flag.
#Returns 'yes', 'no', or 'prompt'.
#If $options given, handle special options.  Only option recognized
#at this time is
#	noprojects: handle 'noprojects' value
#
{	my $rawvalue = shift;
	my $field = shift || 'yes-no-prompt option';
	my $options = shift || {};
	my $value = $rawvalue;
	my $me = 'canonicalize_yes_no_prompt';

	my $noprojects = delete $options->{noprojects};
	if ( %$options )
	{	my @temp = keys %$options;
		my $temp = join ", ", @temp;
		die "$me: unrecognized options [ $temp ] at ";
	}

	#Handle missing value, or if just gave --delete-data w/out MODE
	$value = 1 unless defined $value;
	$value = 'yes' if $value =~ /^\s*1\s*$/;

	$value = lc $value;
	$value = 'yes' if $value eq 'y' || $value eq 't' 
		|| $value eq 'true' || $value eq 'on';
	$value = 'no' if $value eq 'n' || $value eq 'f' 
		|| $value eq 'false' || $value eq 'off';
	$value = 'prompt' if $value eq 'p' || $value eq 'a' 
		|| $value eq 'ask';

	if ( $noprojects )
	{	$value = 'noprojects' if
			$value eq 'noprojects' || $value eq 'noprojs';
		return $value if $value eq 'noprojects';
	}

	unless ( $value eq 'yes' || $value eq 'no' || $value eq 'prompt' )
	{	die "Illegal value '$rawvalue' for $field; expecting one of " .
			"'yes', 'no', or 'prompt'.  Aborting.\n";
	}

	return $value;
}

#------------------------------------------------------
#		This does all the real work
#------------------------------------------------------

sub process_project(@)
#This routine does all the real work.
#It takes key=>value pairs for arguments, recognizing keys:
#	hpc: Glue::HPCC::Cluster instance, REQUIRED
#	project: name of project to delete.  REQUIRED
#	reason: Reason given for removing project, for PDB logs. REQUIRED
#
#	delete_from_pdb: Boolean.  If true, delete from PDB, not just disable.
#		Defaults to false.
#	force: Boolean, whether should skip prompts
#	? dryrun: Boolean, if true, don't actually do anything, just report what 
#		would have been done. Defaults to false.
#	? verbose: Boolean, if true, be chattier than usual. Defaults to false.
#
#On success returns false, dies on errors
{	my %args = @_;
	my $me = 'process_project';

	my $hpc = delete $args{hpc};
	my $project = delete $args{project};
	my $reason = delete $args{reason};
	my $delete_from_pdb = delete $args{delete_from_pdb};
	my $force = delete $args{force};

	my $dryrun = delete $args{dryrun};
	my $verbose = delete $args{verbose};

	if ( %args)
	{	my @temp = keys %args;
		my $temp = join ", ", @temp;
		die "$me: Unrecognized parameters [ $temp ], aborting at ";
	}

	die "$me: Missing/invalid required parm 'hpc' at " unless $hpc && ref($hpc);
	die "$me: Missing required parm 'project' at " unless $project;
	die "$me: Missing required parm 'reason' at " unless $reason;	

	#Defaults

	#Cluster Utility classes
	my $hpcUtil = $hpc->get_hpcUtil;
	#my $userUtil = $hpcUtil->user;
	my $projUtil = $hpcUtil->project;
	my $cluster = $hpc->db_clustername;


	my $proj = Glue::HPCC::Project::Project->project_by_name($hpc, $project);
	my $projid = $proj->prj_pkey;

	#Verify no children
	my $children = Glue::HPCC::Project::Project->children_of_project_by_pkey(
		$hpc, $projid);
	unless ( $children && ref($children) eq 'ARRAY' )
	{	die "Error getting children of project $project: $children at ";
	}
	if ( $delete_from_pdb )
	{	#If deleting record, no children allowed, active or inactive
		if ( scalar(@$children) )
		{	my @children =  map { $_->name . "(" . 
				($_->active?'active':'inactive') . ")" } @$children;
			my $cnames = join ", ", @children;
			die "Refusing to delete project $project, has children [$cnames]\n";
		}
	}
	my @children = grep { $_->active } @$children;
	if ( scalar(@children) )
	{	#If disabling record, no active children allowed. Inactive OK
		my @cnames = map { $_->name } @children;
		my $cnames = join ", ", @cnames;
		die "Refusing to delete project $project, has active children [$cnames]\n";
	}
	
	#Verify no members
	my $users = Glue::HPCC::Project::PersonProject->get_members_of_project(
		$hpc, $project);
	unless ( $users && ref($users) eq 'ARRAY' )
	{	die "Error getting membership of project $project: $users at ";
	}
	if ( scalar(@$users) )
	{	my @unames = map { $_->username } @$users;
		my $unames = join ", ", @unames;
		die "Refusing to disable project $project, has members [$unames]\n";
	}

	#Are any PoCs/coordinators present
	my $pocs = Glue::HPCC::Project::PersonProject->get_pocs_for_project(
		$hpc, $project);
	unless ( $pocs && ref($pocs) eq 'ARRAY' )
	{	die "Error getting PoCs for project $project: $pocs at ";
	}
	my $coords = Glue::HPCC::Project::PersonProject->get_coords_of_project(
		$hpc, $project);
	unless ( $coords && ref($coords) eq 'ARRAY' )
	{	die "Error getting coords for project $project: $coords at ";
	}

	$users = [ grep { $_->is_poc || $_->is_coordinator } @$users ];
	if ( scalar(@$pocs) || scalar(@$coords) )
	{	my %temp = map { $_ => undef } (@$pocs, @$coords);
		my @temp = sort ( keys %temp );
		my $unames = join ", ", @temp;
		if ( $delete_from_pdb )
		{	#Refuse to delete from PDB if PoCs/coordinators present
			die "Refusing to DELETE project $project from PDB with PoCs/coords [ $unames ].\n";
		}

		warn "Project $project has PoCs/coordinators [ $unames ].\n";
		my $res = yorn "Do you still wish to delete?", 'n';
		die "Aborting at user request.\n" unless $res eq 'y';
	}

	#Looks OK to delete
	my $res = $projUtil->delete_project(
		hpc => $hpc,
		project => $project,
		reason => $reason,
		DELETE_PDB => $delete_from_pdb,
	);

	#Commit after each project
	$hpc->db_commit;

	return unless $res;
	die "Error deleting project $project: $res\n";

	
}

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

my $help; 
my $dryrun;
my $verbose;
my $force = 0;
my $delete_from_pdb;
my $projects = [];
my $reason;

my $res = GetOptions(
	'help!' => \$help,
	'dryrun!' => \$dryrun,
	'verbose!' => \$verbose,
	'force!' => \$force,
	'delete-from-pdb|delete_from_pdb:s' => \$delete_from_pdb,
	'project=s' => $projects,
	'reason=s' => \$reason,
);

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

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

unless ( $projects && ref($projects) eq 'ARRAY' && scalar(@$projects) )
{	usage;
	die "\nAt least one project to disable must be given.\n";
}

unless ( $reason )
{	usage;
	die "\nYou must provide a reason for your action.\n";
}

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

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

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

#Validate arguments

#Validate projects given
my @projects = ();
PROJECT: foreach my $projname (@$projects)
{	my $proj = Glue::HPCC::Project::Project->project_by_name(
		$hpc, $projname);
	die "No such project $projname; not in PDB.\n"
		unless $proj;
	die "Error looking up project $projname: $proj at "
		unless ref($proj);

	#Does project have any members
	my $members = Glue::HPCC::Project::PersonProject->get_members_of_project(
		$hpc, $projname);
	if (@$members)
	{	my $unames = join ", ", @$members;
		warn "Refusing to disable project $projname because it has members [$unames].\n";
		warn "Remove members from project and try again.\n";
		next PROJECT;
	}

	my $pocs = Glue::HPCC::Project::PersonProject->get_pocs_for_project(
		$hpc, $projname);
	my $coords = Glue::HPCC::Project::PersonProject->get_coords_of_project(
		$hpc, $projname);
	my %temp = map { $_ => undef } (@$pocs, @$coords);
	my @temp = sort ( keys %temp );
	my $unames = join ", ", @temp;

	if ( $delete_from_pdb && ( scalar(@$pocs) || scalar(@$coords) ) )
	{	
		warn "Refusing to delete project $projname from PDB because if has PoCs/coords [ $unames ].\n";
		warn "Remove all PoCs/coords and try again.\n";
		next PROJECT;
	}

	print "Project $projname has PoCs/coords [ $unames ]\n";
	push @projects, $projname;
}

unless ( @projects )
{	die "No suitable projects to disable/delete.\n";
}

unless ( $force )
{	my $projs = join ", ", @projects;
	my $prompt = "Do you really want to disable project(s): $projs?";
	$prompt = "Do you really want to delete from the PDB project(s): $projs?"
		if $delete_from_pdb;

	my $tmp = yorn $prompt, 'n';
	unless ( $tmp eq 'y' )
	{	die "Aborting at user request.\n";
	}
}

foreach my $projname (@projects)
{	my $err = process_project(
		hpc => $hpc,
		project => $projname,
		reason => $reason,
		force => $force,
		delete_from_pdb => $delete_from_pdb,
		dryrun => $dryrun,
		verbose => $verbose,
	);
	warn "Error processing proj $projname: $err\n" if ( $err );
}

