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

use Getopt::Long;

sub usage()
{	print STDERR <<EOF;
$0: List members of a project

Usage:
$0 [ -cluster CLUSTER ] [ -verbose ] [ -disabled ] [--machine-readable] \
	[ -project PROJECT ] \
	[ -dept DEPTCODE ] [ --coll COLLCODE ] \
	[ -name NAME_REGEXP ] [ -email EMAIL_REGEXP ] 
	[ -username UNAME_REGEXP ] \
	[ -only-disabled ] [ -noonly-cluster ] 

List users in PDB matching criteria.  CLUSTER determines
which PDB to connect to, defaults based on host running command
on.  Normally just the username is displayed; if verbose given
once, it will show fullnames, etc.  If given twice, will also 
show project affiliations, and thrice will also show dept/college
for the projects.

The --only-cluster flag (enabled by default) will restrict output to users
attached to a e to restrict to users attached to a project in the specified 
cluster.  If --noonly-cluster is given, it will list all users in the Person
table of the PDB with the active flag set; this is generally not desired,
as 'delusers' does not currently unset the active flag even when user is no
longer associated with any projects (as the Person table may be shared among 
several clusters, and user might still be attached to projects in another 
cluster).  So --only-cluster is default.  One can additionally use the
-disabled flag to include users with active flag unset (or even --only-disabled
to show only users with active flag unset); these are probably not useful
unless also have --noonly-cluster (as disabled users should NOT be attached
to any projects).

The filtering options may be repeated, in which case the conditions
are ORed within a category (i.e. if any values for the same criterion
are matched, the criterion is matched).  Different categories are
always ANDed.  If nothing is given for a criterion, all values are
matched.

NAME_REGEXP, EMAIL_REGEXP, and UNAME_REGEXP are Perl regular expressions.
If --only-disabled is given, then ONLY disabled accounts are matched
(this automatically sets --disabled as well, otherwise get nothing).

If a PROJECT, DEPTCODE or COLLCODE is given, then the user must be
attached to a matching project in the specified cluster.  Otherwise,
if only matching on name, email, etc., we can match on any users defined
in the person table, which can be shared between clusters.  

--machine-readable will generate a CSV-like file.

EOF
}

sub regexp_filter($$$$)
#Filters list ref based on regexp matching a field
{	my $list = shift;
	my $pkey = shift;
	my $field = shift;
	my $regexp_list = shift || [];

	my @list = ();
	my @tmp;

	foreach my $regexp (@$regexp_list )
	{	@tmp = grep { $_->$field =~ /$regexp/ } @$list;
		push @list, @tmp if @tmp;
	}

	#Remove duplicates
	my %list = map { $_->$pkey => $_ } @list;
	@list = values %list;
	return [ @list ];
}

sub people_projid_filter($$$)
#Filters list ref of people based on assoc with proejcts with given projid
{	my $hpc = shift;
	my $people = shift || [];
	my $projids = shift || [];

	my $ppl_pkeys = [ map { $_->ppl_pkey } @$people ];
	my $perprojs = Glue::HPCC::Project::PersonProject->pdb_query(
		$hpc, ppl_pkey => $ppl_pkeys, prj_pkey => $projids);
	return [] unless $perprojs; #empty is legal result
	die "Error looking up person projects: $perprojs at "
		if $perprojs && ! ref($perprojs);

	$ppl_pkeys = [ map { $_->ppl_pkey } @$perprojs ];
	my %ppl_pkeys = map { $_ => undef } @$ppl_pkeys;

	my @people = grep { exists $ppl_pkeys{$_->ppl_pkey}} @$people;
	return [ @people ];
}


sub deptcodes2projids($$)
#Given a list of college codes, returns projids for all projs in dept
{	my $hpc = shift;
	my $deptcodes = shift || [];

	my @depts = map { Glue::HPCC::Project::Department->dept_by_code(
			$hpc, $_) } @$deptcodes;
	my $deptids = [ map { $_->dept_pkey } @depts];

	my $projs = Glue::HPCC::Project::Project->pdb_query(
		$hpc, department => $deptids);
	die "Error looking up projects in depts: $projs at "
		if $projs && ! ref($projs);

	my @projids = map { $_->prj_pkey } @$projs;
	return [ @projids ];
}


sub collcodes2projids($$)
#Given a list of college codes, returns projids for all projects in the college
{	my $hpc = shift;
	my $collcodes = shift || [];

	my $deptids = [];

	COLLEGE: foreach my $collcode (@$collcodes)
	{	my $coll = Glue::HPCC::Project::College->college_by_code(
			$hpc, $collcode);
		die "No college with code $collcode found in PDB.\n"
			unless $coll;
		die "Error looking up college code $collcode: $coll at "
			unless ref($coll);
		my $collid = $coll->coll_pkey;

		my $tmpdepts = Glue::HPCC::Project::Department->pdb_query(
			$hpc, college=>$collid);
		next COLLEGE unless $tmpdepts;
		die "Error looking up depts for college $collcode at "
			unless ref($tmpdepts);
		$tmpdepts = map { $_->dept_pkey } @$tmpdepts;
		push @$deptids, @$tmpdepts;
	}

	my %temp = map { $_ => $_ } @$deptids;
	$deptids = [ values %temp ];

	my $projs = Glue::HPCC::Project::Project->pdb_query(
		$hpc, department => $deptids);
	die "Error looking up projects in depts: $projs at "
		if $projs && ! ref($projs);

	my @projids = map { $_->prj_pkey } @$projs;
	return [ @projids ];
}

sub cluster_projids($)
#Returns list of all projids for cluster
{	my $hpc = shift;

	my $projs = Glue::HPCC::Project::Project->pdb_query(
			$hpc);
	die "Error looking up projects for cluster at "
		if $projs && ! ref($projs);
	unless ( $projs )
	{	warn "No projects found in cluster.  Problems????";
		return [];
	}

	my @projids = map { $_->prj_pkey } @$projs;
	return [ @projids ];
}

sub dump_user($$$)
#For dumping at verbosity 2 or higher
{	my $hpc = shift;
	my $verbose = shift;
	my $username = shift;

	my $user = Glue::HPCC::Project::Person->person_by_username(
		$hpc, $username);
	die "Invalid user $username at " unless $user && ref($user);

	my $full = $user->fullname;
	my $email = $user->email;
	my $disflag = '';
	$disflag = '*' unless $user->active;
	
	my $pplprjs = Glue::HPCC::Project::PersonProject->get_project_persons_by_username(
		$hpc, $username);
	my $projstr = "";
	if ( $pplprjs )
	{	unless ( ref($pplprjs) eq 'ARRAY' )
		{	die "*** ERROR looking up projects for $username at ";
		}

		#Only want projects where are actually member, coord. or poc
		$pplprjs = [ grep { $_->is_member || $_->is_poc || $_->is_coordinator } @$pplprjs ];

		#And kill it if empty
		$pplprjs = undef unless scalar(@$pplprjs);
	}

	if ( $pplprjs )
	{	foreach my $pplprj (@$pplprjs)
		{	my $prj_pkey = $pplprj->prj_pkey;
			my $pocflag = '';
			$pocflag='*' if $pplprj->is_poc;

			my $proj = Glue::HPCC::Project::Project->project_by_pkey(
				$hpc, $prj_pkey);
			unless ( $proj )
			{	die "*** ERROR *** user $username has pplprj entry to "
					. "non-existant project $prj_pkey at";
			}
			unless ( ref($proj) )
			{	die "***ERROR looking up project with pkey=$prj_pkey; $proj at ";
			}

			my $projname = $proj->name;
			my $deptid = $proj->department;

			my $dept = Glue::HPCC::Project::Department->dept_by_pkey(
				$hpc, $deptid);
			unless ( $dept )
			{	die "*** ERROR project $projname has nonexist dept=$deptid at ";
			}
			unless ( ref($dept) )
			{	die "*** ERROR looking up dept with id=$deptid; $dept at ";
			}
			my $deptcode = $dept->code;
			my $deptname = $dept->name;

			my $collid = $dept->college;
			my $coll = Glue::HPCC::Project::College->college_by_pkey(
				$hpc, $collid);
			unless ( $coll )
			{	die "*** ERROR dept $deptcode has nonexist college=$collid at ";
			}
			unless ( ref($coll) )
			{	die "*** ERROR looking up college $collid: $coll at ";
			}

			my $collcode = $coll->code;
			my $collname = $coll->name;

			$projstr .= ", " if $projstr;
			if ( $verbose > 2 )
			{	$projstr .= "$projname$pocflag($deptname/$collname)";
			} else {
				$projstr .= "$projname$pocflag";
			}
		}
	} else
	{	$projstr = "Not attached to any projects.";
	}
	print "$username: $full ($email): Projects=$projstr\n";
}


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

my $cluster;
my $help;
my $verbose = 0;
my $inactive;
my $projects = [];
my $colleges = [];
my $depts = [];
my $name_res = [];
my $email_res = [];
my $uname_res = [];
my $only_inactive;
my $only_cluster=1;
my $machine;

my $res = GetOptions(
	'help!' => \$help,
	'verbose+' => \$verbose,
	'cluster=s' => \$cluster,
	'disabled!' => \$inactive,
	'machine!' => \$machine,

	'only-inactive|onlyinactive|only_inactive!' => \$only_inactive,
	'only-cluster|onlycluster|only_cluster!' => \$only_cluster,
	'project=s' => $projects,
	'college=s' => $colleges,
	'department|dept=s' => $depts,
	'name|full-name|fullname|full_name=s' => $name_res,
	'email|mail|e-mail=s' => $email_res,
	'username|uid|user-name|user_name=s' => $uname_res,
);

my $tmp;

unless ( $res ) 
{	usage;
	die "\nError processing options.\n";
}
if ( $help )
{	usage;
	exit 0;
}
if ( scalar(@ARGV) )
{	$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;

#Need to set --disabled if --only-disabled, otherwise drop everything
$inactive = 1 if $only_inactive;

#Get ALL users
my $allusers = Glue::HPCC::Project::Person->pdb_query($hpc);
die "No users at all found; something seriously wrong???" 
	unless $allusers;
die "Error getting all users: $allusers" unless ref($allusers);
die "No users at all found; something seriously wrong???" 
	unless scalar(@$allusers);
my @users = @$allusers;

#Filter on status
@users = grep { $_->active } @users  unless $inactive;
@users = grep { ! $_->active } @users if $only_inactive;

#Do regexp filters
if ( $uname_res && ref($uname_res) eq 'ARRAY' && scalar(@$uname_res) )
{	$tmp = regexp_filter(\@users, 'ppl_pkey', 'username', $uname_res);
	@users = @$tmp;
}
if ( $name_res && ref($name_res) eq 'ARRAY' && scalar(@$name_res) )
{	$tmp = regexp_filter(\@users, 'ppl_pkey', 'fullname', $name_res);
	@users = @$tmp;
}
if ( $email_res && ref($email_res) eq 'ARRAY' && scalar(@$email_res) )
{	$tmp = regexp_filter(\@users, 'ppl_pkey', 'email', $email_res);
	@users = @$tmp;
}

#Do project/dept/college filters

my $projids;
my $proj_filtered=0;
if ( $projects && ref($projects) eq 'ARRAY' && scalar(@$projects) )
{	$projids = map { Glue::HPCC::Project::Project->project_by_name(
		$hpc, $_) } @$projects;
	$projids = [ grep { $_ } @$projids ];
	$projids = [ map { $_->prj_pkey } @$projids ];
	$tmp =  people_projid_filter($hpc, \@users, $projids);
	@users = @$tmp;
	$proj_filtered=1;
}

if ( $depts && ref($depts) eq 'ARRAY' && scalar(@$depts) )
{	$projids = deptcodes2projids($hpc, $depts);
	$tmp =  people_projid_filter($hpc, \@users, $projids);
	@users = @$tmp;
	$proj_filtered=1;
}

if ( $colleges && ref($colleges) eq 'ARRAY' && scalar(@$colleges) )
{	$projids = collegecodes2projids($hpc, $colleges);
	$tmp =  people_projid_filter($hpc, \@users, $projids);
	@users = @$tmp;
	$proj_filtered=1;
}

if ( $only_cluster && ! $proj_filtered )
{	$projids = cluster_projids($hpc);
	$tmp =  people_projid_filter($hpc, \@users, $projids);
	@users = @$tmp;
}

unless ( scalar(@users) )
{	print "\nNo matching users found\n";
	exit 0;
}

my $fmt="%-10s %-20s %-20s %-7s\n";
$fmt="%s|%s|%s|%s\n" if $machine;
if ( $verbose )
{	my $tmpfmt = $fmt;
	$tmpfmt = "#$tmpfmt" if $machine;
	printf $tmpfmt, "Username", "Name", "Email", "UID";
}

@users = sort { $a->username cmp $b->username } @users;

foreach my $user (@users)
{	my $username = $user->username;
	my $full = $user->fullname;
	my $email = $user->email;
	my $uid = $user->uid;
	my $disflag = '';
	$disflag = '*' unless $user->active;

	if ( $verbose > 1 )
	{	dump_user($hpc, $verbose, $username);
	} elsif ( $verbose )
	{	printf $fmt, $username . $disflag, $full, $email, $uid;
	} else
	{	print "$username\n";
	}
}
