#!/usr/local/bin/perl
#
#Script to report on prjects in PDB
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::PersonProject;
use Glue::HPCC::Project::Project;
use Glue::HPCC::Project::ProjectType;
use Glue::HPCC::Project::College;
use Glue::HPCC::Project::Department;

use Getopt::Long;

sub usage()
{	print STDERR <<EOF;
$0: Display information about a project

Usage:
$0 [ -verbose ] [ -project ]  PROJECT

Shows detailed information about a project. 
Multiple PROJECTs can be given.

If --verbose is given, displays membership.
If --verbose given two or three times, displays successfully more detail.

EOF
}

my $projsep='';

sub dump_project($$;$)
#Dump a project
{	my $hpc = shift;
	my $proj = shift;
	my $verbose = shift || 0;
	my $me = 'dump_project';

	die "$me: Invalid/missing hpc object '$hpc' at "
		unless $hpc && ref($hpc);
	die "$me: Invalid/missing proj object '$proj' at "
		unless $proj && ref($proj);

	my $prj_pkey = $proj->prj_pkey;
	my $project = $proj->name;
	my $desc = $proj->description;
	my $group = $proj->unixgroup || '';
	my $parentid = $proj->parent;
	my $exp = $proj->expiration;
	my $ptypeid = $proj->projtype;
	my $active = $proj->active;
	my $su = $proj->su;
	my $thrhld_pct_over = $proj->thrhld_pct_over;
	my $thrhld_pct_under = $proj->thrhld_pct_under;
	my $deptid = $proj->department;
	my $created = $proj->created;
	my $lastupdated = $proj->lastupdated;
	my $cluster = $hpc->clustername;

	my $parent = '---';
	if ( defined $parentid )
	{	my $parproj = Glue::HPCC::Project::Project->project_by_pkey(
			$hpc, $parentid);
		die "$me: Parent (id=$parentid) of $project  not found in PDB at "
			unless $parproj;
		die "$me: Error looking up parent for $project: $parproj at "
			unless ref($parproj);
		$parent = $parproj->name;
	}

	my $ptype = Glue::HPCC::Project::ProjectType->projecttype_by_pkey(
		$hpc, $ptypeid);
	die "$me: ProjectType=$ptypeid not found in PDB for $project at "
		unless $ptype;
	die "$me: Error looking up projtype for $project: $ptype at "
		unless ref($ptype);
	my $ptname = $ptype->name;

	my $actflag = '';
	$actflag = '[ DISABLED ]' unless $active;

	my ($deptcode, $deptname, $collcode, $collname);
	$deptcode = $collcode = '----';
	$deptname = $collname = '--missing--';
	if ( defined $deptid )
	{ 	my $dept = Glue::HPCC::Project::Department->dept_by_pkey(
			$hpc, $deptid);
		die "Illegal deptid $deptid for project $project, not in PDB.\n"
			unless $dept;
		die "Error looking up dept for $deptid: $dept.\n" unless ref($dept);
		$deptcode = $dept->code;
		$deptname = $dept->name;
		my $collid = $dept->college;
		my $coll = Glue::HPCC::Project::College->college_by_pkey(
			$hpc, $collid);
		die "Illegal collid $collid for project $project, not in PDB.\n"
			unless $coll;
		die "Error looking up coll for $collid: $coll.\n" unless ref($coll);
		$collcode = $coll->code;
		$collname = $coll->name;
	} else 
	{	warn "Missing department for project $project.\n";
	}

	$su = 0 unless defined $su;
	my $ksu = sprintf "%0.3f", $su/1000;
	
	if ( defined $thrhld_pct_over )
	{	$thrhld_pct_over = sprintf "%.1f %%", $thrhld_pct_over;
	} else
	{	$thrhld_pct_over = '----';
	}
	if ( defined $thrhld_pct_under )
	{	$thrhld_pct_under = sprintf "%.1f %%", $thrhld_pct_under;
	} else
	{	$thrhld_pct_under = '----';
	}

	my $people_recs = Glue::HPCC::Project::PersonProject->pdb_query(
		$hpc, prj_pkey => $prj_pkey);
	die "$me: Error looking up people associate with project $project: " .
		"$people_recs at " 
		unless $people_recs && ref($people_recs) eq 'ARRAY';
	my @people = map { Glue::HPCC::Project::Person->person_by_pkey($hpc,
		$_->ppl_pkey) } @$people_recs;
	@people = grep { $_->active } @people;
	my %username_by_pkey = map { $_->ppl_pkey => $_->username }
		@people;

	my @pocs = grep { $_->is_poc } @$people_recs;
	@pocs = map { $username_by_pkey{$_->ppl_pkey} } @pocs;
	my $pocs = join ', ', @pocs;

	my @coords = grep { $_->is_coordinator } @$people_recs;
	@coords = map { $username_by_pkey{$_->ppl_pkey} } @coords;
	my $coords = join ', ', @coords;

	my @users = grep { $_->is_member} @$people_recs;
	@users = map { $username_by_pkey{$_->ppl_pkey} } @users;
	my $users = join ', ', @users;

	print $projsep;
	$projsep = <<EOF;

-----------------------------------------------------------------------
EOF

	print <<EOF;
Project: $project ($prj_pkey) $actflag
Cluster: $cluster
Project Type: $ptname
Parent Project: $parent
Department: $deptname ($deptcode)
College: $collname ($collcode)

Expiration: $exp
kSU: $ksu
EOF
	print <<EOF if $verbose > 1;
Overusage alert threshold: $thrhld_pct_over
Underusage alert threshold: $thrhld_pct_under

Description: $desc
Unix Group: $group

EOF
	print "\n" unless $verbose > 1;
	print <<EOF if $verbose;
Points of Contact: $pocs
Coordinators: $coords
Members: $users
EOF

	print <<EOF if $verbose > 2;

Created: $created
Last Updated: $lastupdated
EOF
}
		

	
	


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

my $help;
my $cluster;
my $projects = [];
my $verbose = 0;

my $res = GetOptions(
	'help!' => \$help,
	'verbose+' => \$verbose,
	'cluster=s' => \$cluster,
	'project=s' => $projects,
);

unless ( $res ) 
{	usage;
	die "\nError processing options.\n";
}
if ( $help )
{	usage;
	exit 0;
}
if ( scalar(@ARGV) )
{	if ( scalar(@$projects) == 0 )
	{	#Allow user to omit --project
		$projects = [ @ARGV ];
	} else
	{	my $tmp = join ", ", @ARGV;
		usage;
		die "\nError: extraneous 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;

unless ( scalar(@$projects) )
{	usage;
	die "\nNo projects specified.\n";
}

PROJECT: foreach my $project (@$projects)
{	my $proj= Glue::HPCC::Project::Project->project_by_name($hpc,$project);
	unless ( $proj )
	{	warn "Project $project NOT found.\n";
		next PROJECT;
	}
	unless ( ref($proj) )
	{	warn "Error looking up project $project: $proj at ";
		next PROJECT;
	}

	dump_project($hpc, $proj, $verbose);

}
