#!/usr/local/bin/perl
#
#Script to report on prjects in PDB
use strict;
use warnings;

use lib "/cell_root/software/HPCC/lib/site_perl";
#Temporary for debugging
#use lib "/afs/.glue.umd.edu/software/HPCC/1.1/lib/site_perl";

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

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

#-------------------------------------
#	Globals
#-------------------------------------

#Declare prototype
sub generate_known_fields_hash($);

my $PARSABLE;
my $DEBUG;

#Known fields is a list of field specifications.
#Field specifications are hash ref with keys
#name: name of field (can have case, will be insensitized later)
#title: title to use for display, optional (defaults to name)
#defwidth: default width for field
#defprec: default precision for floating fields
#aliases: list ref of alias names
my @KNOWN_FIELDS =
(	{	name => 'Key',
		aliases => [ 'PrimaryKey' ],
		defwidth => 4,
		desc => 'Primary Key of Project in PDB',
	},

	{	name => 'Project',
		aliases => [ 'Name' ],
		defwidth => 16,
		desc => 'Name of Project',
	},

	{	name => 'Cluster',
		defwidth => 10,
		desc => 'Name of Cluster',
	},

	{	name => 'Desc',
		title => 'Description',
		aliases => [ 'Description' ],
		defwidth => 30,
		desc => 'Description of Project',
	},

	{	name => 'UnixGroup',
		aliases => [ 'Group' ],
		defwidth => 19,
		desc => 'Name of unix group associated with project',
	},

	{	name => 'ParentID',
		defwidth => 8,
		desc => 'projid of parent project',
	},

	{	name => 'Parent',
		aliases => [ 'ParentProject' ],
		defwidth => 16,
		desc => 'Name of parent project',
	},

	{	name => 'DeptKey',
		title => 'DKey',
		aliases => [ 'DeptCode', 'DepartmentKey', 'DepartmentCode' ],
		defwidth => 4,
		desc => 'Department key',
	},

	{	name => 'Dept',
		title => 'Dept',
		aliases => [ 'Department' ],
		defwidth => 8,
		desc => 'Name of department',
	},

	{	name => 'CollKey',
		title => 'CKey',
		aliases => [ 'CollegeKey', 'CollCode', 'CollegeCode' ],
		defwidth => 4,
		desc => 'College key',
	},

	{	name => 'College',
		aliases => [ 'Coll' ],
		defwidth => 12,
		desc => 'Name of college',
	},

	{	name => 'PTKey',
		aliases => [ 'PTypeKey', 'ProjectTypeKey' ],
		defwidth => 6,
		desc => 'ProjectType key',
	},

	{	name => 'PType',
		aliases => [ 'ProjectType', 'Type' ],
		defwidth => 9,
		desc => 'ProjectType (name)',
	},

	{	name => 'SU',
		defwidth => 12,
		desc => 'SUs',
	},

	{	name => 'kSU',
		defwidth => 9,
		defprec => 1,
		desc => 'kSUs',
	},

	{	name => 'Active',
		title => 'Act',
		defwidth => 3,
		desc => 'Yes/No depending on whether project is active',
	},

	{	name => 'Expiration',
		aliases => [ 'Exp' ],
		defwidth => 10,
		desc => 'Date project expires',
	},

	{	name => 'ThrPctOver',
		title => '%Over',
		defwidth => 6,
		defprec => 1,
		desc => 'Threshold for overuse warnings (%)',
	},

	{	name => 'ThrPctUnder',
		title => '%Under',
		defwidth => 6,
		defprec => 1,
		desc => 'Threshold for overuse warnings (%)',
	},

	{	name => 'PoCs',
		title => 'Points-of-Contact',
		desc => 'Points-of-Contact for the project (comma delim list of usernames)',
		aliases => [ 'PIs' ],
		defwidth => 24,
	},

	{	name => 'Members',
		desc => 'Members/users for the project (comma delim list of usernames)',
		aliases => [ 'Users' ],
		defwidth => 42,
	},

	{	name => 'Coordinators',
		desc => 'Coordinators for the project (comma delim list of usernames)',
		aliases => [ 'Coords' ],
		#Currently, do not use coordinators, so default to small width
		title => 'Coords',
		defwidth => 8,
	},
);
my %KNOWN_FIELDS = generate_known_fields_hash(\@KNOWN_FIELDS);

my %PSEUDO_FIELDS =
(	'help' => { name=>'Help', special=>'help', desc => 'Print field help text', },
	'reset'=> { name=>'Reset', special=>'reset', desc => 'Ignore all previous field specifiers', },
	'standard' => { name =>'Standard', fields=>[ 'project' ], desc=>'Add standard mode field(s)' },
	'verbose' => { name =>'Verbose', 
			fields=>[ 'project', 'cluster', 'college', 'dept', 'ptype', 'ksu', 'expiration' ],
			desc=>'Add verbose field(s)' },
	'verbose2' => { name =>'Verbose2', 
			fields=>[ 'project', 'cluster', 'college', 'dept', 'ptype', 'ksu', 'expiration',
				'unixgroup', 'parentproject', 'active' ],
			desc=>'Add doubly verbose field(s)' },
);

#-------------------------------------
#	Display usage info
#-------------------------------------

sub usage()
{	print STDERR <<EOF;
$0: List projects

Usage:
$0 [ -verbose [ --parsable ] ] \\
	[ --fields FIELD1 [ --fields FIELD2 ... ] ] \\
	[ --[no]headers ] \\
	[ -cluster CLUSTER ] \\
	[ -status active|inactive|both ] \\
	[ -renewable | -notrenewable] \\
	[ -type TYPE ] [ -project PROJECT ] \\
	[ -parent PARENT ] \\
	[ -dept DEPTCODE ] [ -college COLLEGE_CODE ] 

List projects in HPC cluster.  If CLUSTER is not provided, it
will be defaulted based on the system you are running the command
on (i.e. whatever HPC cluster it belongs to).

The options --verbose, --parsable and --fields control what is 
reported.  The --fields option can be given multiple times to cause
multiple fields in order to be printed; alternatively, you can provide
comma delimited lists of field specifiers.  Use --help fields for more
information on specifying fields.  

If no fields are specified, then the field specifier list will default to
just the project name unless --verbose was given.  Using --verbose prints
additional fields, and using it twice prints yet more fields. 
(Use --help fields for details.) If --parsable is given, 
results are in a machine parsable format.

If --headers is given, a header line will be printed.  If --noheaders
given, none will be printed.  By default, headers will be printed if
more than one field is to be output.

The remaining arguments are for filtering what projects will be
listed.  If no criteria are given, all projects for the cluster (which
might be defaulted) will be listed.

The -type, -project, -parent, -dept, and -college arguments allow one
to restrict the projects listed based on project type,
project name, name of the parent project, department 
and/or college the project is associated
with.  They may all be repeated.  For each category, a project is
considered to match if it matches any of the values given for that
category.  If no values are given for a category, all projects will
match that category.  The different categories are ANDed. 
If PARENT is set to "NONE", that will match projects without a parent;
if set to "ANY", will match any project with a parent; otherwise
matches projects with specific named parents.

Status determines whether to see only active projects, only inactive
projects, or both.  Default is only active.  If -renewable is set, only
show renewable projects.  If -notrenewable is set, only show non-renewing
projects.  Obviously, useless to use both.

EOF
}

sub usage_fields()
{	print STDERR <<EOF;
Field specifiers for $0

The fields to be output can be specified in several ways.  The most
flexible is by given a list of field specifiers to the script via
the --fields argument.  This generates a list of field specifiers
to be used when outputting projects.  The fields in the specifier
list will be displayed left to right on the output line in order
they were given to the script (except as noted).  The argument
to --fields can either be a single field specifier, or multiple
field specifiers separated by commas.  The --fields option can
be repeated, and the new values are appended to the old (except
as noted below).

Field specifiers consist of a field name (case insensitive) optionally
followed by a colon (':') and an integer giving the minimum width
for the field (widths are ignored in machine parsable mode), or for
floating point values, two integers with a '.' between for minimum
width and precision.

Valid field names (and there default width) are:
Fieldname	Default Width	Description
EOF

	foreach my $fldrec (@KNOWN_FIELDS)
	{	my $name = $fldrec->{name};
		my $defwidth = $fldrec->{defwidth};
		my $defprec = $fldrec->{defprec};
		my $deffmt = $defwidth;
		$deffmt .= ".$defprec" if ( defined $defprec );
		my $desc = $fldrec->{desc};
		my $aliases = $fldrec->{aliases} || [];

		my $aliasstr = '';
		if ( scalar(@$aliases) )
		{	$aliasstr = join ", ", @$aliases;
			$aliasstr = "($aliasstr)";
		}

		printf STDERR "%30s %6s %40s\n", "$name $aliasstr", $deffmt, $desc;
	}

	print STDERR <<EOF;

Some special pseudo-specifiers are also available:
EOF
	foreach my $psrec (values %PSEUDO_FIELDS)
	{	my $name = $psrec->{name};
		my $desc = $psrec->{desc};
		my $fields = $psrec->{fields};

		print STDERR "$name: $desc\n";
		if ( $fields && ref($fields) eq 'ARRAY' )
		{	my $flds = join ', ', @$fields;
			print STDERR "(Equivalent to specifying [ $flds ])\n";
		}
	}
	print STDERR "\n";
}

#-------------------------------------
#	Handle field specifications
#-------------------------------------

sub generate_known_fields_hash($)
#Given a list ref of known field hashes
#(consisting of name, title(optional), aliases(opt), defwidth,
#and desc keys), generate the known fields hash.
#Keys are (lowercased) names of the fields (primary or alias),
#with value being the known fields hash with defaults added.
{	my $kfarray = shift;
	my $me = 'generate_known_fields_hash';
	die "$me: kfarry is missing at " unless $kfarray;
	die "$me: kfarry is a ", ref($kfarray), " not a aref at " 
		unless $kfarray && ref($kfarray) eq 'ARRAY';

	my %kfhash = ();
	my $recno = 0;

	foreach my $kfrec (@$kfarray)
	{	$recno++;
		my $name = $kfrec->{name};
		die "Error with rec # $recno: no name field at "
			unless $name;
		my $title = $kfrec->{title} || $name;
		my $aliases = $kfrec->{aliases} || [];
		my $defwidth = $kfrec->{defwidth};
		die "Error with rec # $recno ($name): no defwidth at "
			unless defined $defwidth;
		my $defprec = $kfrec->{defprec};
		my $desc = $kfrec->{desc};
		die "Error with rec # $recno ($name): no desc at "
			unless $desc;

		
		my $outkfrec = {
			name => $name,
			title => $title,
			aliases => $aliases,
			defwidth => $defwidth,
			defprec => $defprec,
			desc => $desc,
		};

		my $lcname = lc $name;
		if ( exists $kfhash{$lcname} )
		{	die "Multiple known field records for $lcname: rec=$recno, at ";
		}
		$kfhash{$lcname} = $outkfrec;

		foreach my $alias (@$aliases)
		{	$lcname = lc $alias;
			die "Multiple known field records for alias $lcname: rec=$recno, at "
				if exists $kfhash{$lcname};
			$kfhash{$lcname} = $outkfrec;
		}
	}

	return %kfhash;
}

sub generate_fields_list($)
#Takes a list ref of field specifier strings (an individual element can be a comma separated list of field
#specifiers as well), and generates a list ref of field specifers, i.e. a list ref of hash refs
#with keys
#	name: canonical name of field specifier
#	given: name used in generating this entry (for debugging)
#	title: title to use for this field
#	width: the width to use for this field
#	prec: the precision to use for this field
#
#Returns list ref on success, or non-ref error message on non-fatal error
{   my $inarray = shift || [];
    my $me = 'generate_fields_list';

    my $fldlist = [];

    foreach my $inrec1 (@$inarray)
    {	#Remove leading/trailing spaces
	$inrec1 =~ s/^\s*//; $inrec1 =~ s/\s*$//;
	#Split comma separated elements into a sublist
	my @temp = split /\s*,\s*/, $inrec1;
	#and loop over real records
	FLDREC: while ( my $inrec = shift @temp)
	{	#Parse into name, width, and prec

		my $given = $inrec;
		my ($name, $title, $width, $prec, $tmp);
		if ( $inrec =~ /:/ )
		{	($name, $tmp) = split /\s*:\s*/, $inrec, 2;
			if ( $tmp =~ /\./ )
			{	#Have precision as well as width
				($width, $prec) = split /\s*\.\s*/, $tmp, 2;
			} else
			{	$width = $tmp;
			}
		} else
		{	$name = $inrec;
		}
		$name = lc $name;

		#Look up name
		if ( exists $KNOWN_FIELDS{$name} )
		{	#Got a real field
			my $kfrec = $KNOWN_FIELDS{$name};
			#Default anything needing defaulting

			$name = $kfrec->{name}; #Canonicalize the name

			$title = $kfrec->{title} unless defined $title;
			$width = $kfrec->{defwidth} unless defined $width;
			$prec = $kfrec->{defprec} unless defined $prec;

			debug("Adding fldrec for $name...");
			my $outkfrec = {
				name => $name,
				given => $given,
				title => $title,
				width => $width,
				prec => $prec,
			};
			push @$fldlist, $outkfrec;
			next FLDREC;
		}

		#Not a known regular field, try pseudo-fields
		my $pfld = $PSEUDO_FIELDS{$name};

		unless ( $pfld && ref($pfld) eq 'HASH' )
		{	die "$me: Unrecognized field specifier '$given'; $name is not field, alias, or pseudo-field at ";
			return "$me: Unrecognized field specifier '$given'; $name is not field, alias, or pseudo-field";
		}

		#Process special psuedo-fields first
		my $special = $pfld->{special} || '';
		if ( $special eq 'help' )
		{	usage_fields;
			exit 0;
		} elsif ( $special eq 'reset' )
		{	$fldlist = [];
			next FLDREC;
		} elsif ( $special )
		{	die "$me: Do not know how to handle pseudo-field $name with special=$special, aborting at ";
		}

		my $expand = $pfld->{fields};
		unless ( $expand && ref($expand) eq 'ARRAY' )
		{	die "$me: Do not know how to handle pseudo-field $name w/out special or fields fields, aborting at ";
		}

		unshift @temp, @$expand;
		next FLDREC;
	}
    }

    return $fldlist;
}

#-------------------------------------
#	Helper routines for fields requiring additional lookups
#-------------------------------------

my %_cached_project_names_by_id = ();

sub get_project_name_from_id($$)
#Returns name of project given project id/key.
#Needed for expanding parentid to parent name.
#Use cached values when possible
{	my $hpc = shift;
	my $projid = shift;

	my $pname = $_cached_project_names_by_id{$projid};
	return $pname if $pname;

	unless (defined $projid)
	{	warn "Undef projid at ";
		return '<unknown>';
	}

	#Not cached, look it up
	my $tmp;
	my $proj = Glue::HPCC::Project::Project->project_by_pkey($hpc,$projid);
	unless ( $proj && ref($proj) )
	{	warn "Error looking up project with id $projid: $proj\n";
		$tmp = '<unknown>';
		$_cached_project_names_by_id{$projid} = $tmp;
		return $tmp;
	}

	$tmp = $proj->name;
	$_cached_project_names_by_id{$projid} = $tmp;
	return $tmp;
}

my %_cached_project_ids_by_name = ();

sub get_project_id_from_name($$)
#Returns id of project given project name
#Needed for matching against parent names
#Use cached values when possible
{	my $hpc = shift;
	my $projname = shift;

	my $projid = $_cached_project_ids_by_name{$projname};
	return $projid if $projid;

	unless (defined $projname)
	{	warn "Undef projname at ";
		return;
	}

	#Not cached, look it up
	my $tmp;
	my $proj = Glue::HPCC::Project::Project->project_by_name($hpc,$projname);
	unless ( $proj && ref($proj) )
	{	warn "Error looking up project named $projname: $proj\n";
		return;
	}

	$tmp = $proj->prj_pkey;
	$_cached_project_ids_by_name{$projname} = $tmp;
	return $tmp;
}

my %_cached_deptrec_by_id = ();

sub get_deptrec_from_id($$)
#Returns dept record from id/key.
#Needed for expanding deptkey to dept name, and/or getting college info
#Use cached values when possible
{	my $hpc = shift;
	my $deptid = shift;

	my $deptrec = $_cached_deptrec_by_id{$deptid};
	return $deptrec if $deptrec;

	#Not cached, look it up
	my $dept = Glue::HPCC::Project::Department->dept_by_pkey($hpc,$deptid);
	unless ( $dept && ref($dept) )
	{	warn "Error looking up dept with id $deptid: $dept\n";
		my $tmp = { 	dept_pkey => $deptid,
				code => 'UNKN',
				name => '<unknown>',
				description => 'not found',
				college => '-1',
			};
		$_cached_deptrec_by_id{$deptid} = $tmp;
		return $tmp;
	}

	$_cached_deptrec_by_id{$deptid} = $dept;
	return $dept;
}


my %_cached_college_by_id = ();

sub get_college_from_id($$)
#Returns college name from id/key.
#Needed for expanding collkey to college name
#Use cached values when possible
{	my $hpc = shift;
	my $collkey = shift;

	my $cname = $_cached_college_by_id{$collkey};
	return $cname if $cname;

	#Not cached, look it up
	my $tmp;
	my $coll = Glue::HPCC::Project::College->college_by_pkey($hpc,$collkey);
	unless ( $coll && ref($coll) )
	{	warn "Error looking up coll with id $collkey: $coll\n";
		$tmp = '<unknown>';
		$_cached_college_by_id{$collkey} = $tmp;
		return $tmp;
	}

	$tmp = $coll->code;
	$_cached_college_by_id{$collkey} = $tmp;
	return $tmp;
}

sub get_projecttype_from_ptkey($$)
#Returns projecttype name from ptkey
#Caching is handling in Glue::HPCC::Project::ProjectType, so don't bother here
{	my $hpc = shift;
	my $ptkey = shift;

	my $ptype = Glue::HPCC::Project::ProjectType->projecttype_by_pkey(
		$hpc, $ptkey);
	unless ( $ptype && ref($ptype) )
	{	warn "Unable to lookup projtype ptkey=$ptkey: $ptype at ";
		return '<unknown>';
	}

	return $ptype->name;
}

#-------------------------------------
#	Debugging routines
#-------------------------------------

sub debug(@)
{	return unless $DEBUG;
	my $text = join '', @_;
	chomp $text;
	print STDERR "[DEBUG] $text\n";
}

sub dump_field_specs($)
#Dumps output field specifier list
{	my $fldrecs = shift;
	my $me = "dump_field_specs";

	die "$me: Invalid/missing fldrecs '$fldrecs', expecting list ref at "
		unless $fldrecs && ref($fldrecs) eq 'ARRAY';

	my $fmt = "%-15s %-8s %-8s %-20s";
	my $str = sprintf $fmt, "Name", "Width", "Prec", "Title";
	debug($str);
	foreach my $fldrec (@$fldrecs)
	{	my $fldname = $fldrec->{name};
		my $title = $fldrec->{title} || '';
		my $width = $fldrec->{width};
		my $prec = $fldrec->{prec};
		$width = '' unless defined $width;
		$prec = '' unless defined $prec;

		$str = sprintf $fmt, $fldname, $width, $prec, $title;
		debug($str);
	}
}


#-------------------------------------
#	Output routines
#-------------------------------------


sub get_project_field($$$;$$)
#Given a hpc instance, a project hash and a field name (from KNOWN_FIELDS list),
# optionally with width and precision, this will return the appropriately 
#formated record. $hpc instance is required because some fields require 
#additional queries.
{	my $hpc = shift;
	my $project = shift;
	my $fldname = shift;
	my $width = shift;
	my $prec = shift;
	my $me = 'get_project_field';

	$fldname = lc $fldname;
	my ($value, $type, $tmp); 

	if ( $fldname eq 'key' )
	{	$value = $project->prk_pkey;
		$type = 'int';
	} elsif ( $fldname eq 'project' )
	{	$value = $project->name;
		$type = 'string';
	} elsif ( $fldname eq 'cluster' )
	{	$value = $hpc->db_clustername;
		$type = 'string';
	} elsif ( $fldname eq 'desc' )
	{	$value = $project->description;
		$type = 'string';
	} elsif ( $fldname eq 'unixgroup' )
	{	$value = $project->unixgroup;
		$type = 'string';
	} elsif ( $fldname eq 'parentid' )
	{	$value = $project->parent;
		$type = 'int';
	} elsif ( $fldname eq 'parent' )
	{	$tmp = $project->parent;
		if ( defined $tmp )
		{	$value = get_project_name_from_id($hpc,$tmp);
		} else
		{	$value = 'ROOT';
		}
		$type = 'string';
	} elsif ( $fldname eq 'deptkey' )
	{	$value = $project->department;
		$type = 'int';
	} elsif ( $fldname eq 'dept' )
	{	$tmp = $project->department;
		$tmp = get_deptrec_from_id($hpc, $tmp);
		$value = $tmp->code;
		$type = 'string';
	} elsif ( $fldname eq 'collkey' )
	{	$tmp = $project->department;
		$tmp = get_deptrec_from_id($hpc, $tmp);
		$value = $tmp->college;
		$type = 'int';
	} elsif ( $fldname eq 'college' )
	{	$tmp = $project->department;
		$tmp = get_deptrec_from_id($hpc, $tmp);
		$tmp = $tmp->college;
		$value = get_college_from_id($hpc, $tmp);
		$type = 'string';
	} elsif ( $fldname eq 'ptkey' )
	{	$value = $project->projtype;
		$type = 'int';
	} elsif ( $fldname eq 'ptype' )
	{	$tmp = $project->projtype;
		$value = get_projecttype_from_ptkey($hpc, $tmp);
		$type = 'string';
	} elsif ( $fldname eq 'su' )
	{	$value = $project->su;
		$type = 'float';
	} elsif ( $fldname eq 'ksu' )
	{	$value = $project->su/1000;
		$type = 'float';
	} elsif ( $fldname eq 'active' )
	{	$value = $project->active;
		$type = 'bool';
	} elsif ( $fldname eq 'active' )
	{	$value = $project->active;
		$type = 'bool';
	} elsif ( $fldname eq 'expiration' )
	{	$value = $project->expiration;
		$value =~ s/ .*$//;
		$type = 'string';
	} elsif ( $fldname eq 'thrpctover' )
	{	$value = $project->thrhld_pct_over;
		$type = 'float';
	} elsif ( $fldname eq 'thrpctunder' )
	{	$value = $project->thrhld_pct_under;
		$type = 'float';
	} elsif ( $fldname eq 'pocs' )
	{	$value = Glue::HPCC::Project::PersonProject->get_pocs_for_project(
			$hpc, $project->name);
		unless ( $value && ref($value) )
		{	warn "Error looking up PoCs for project " .
				$project->name . "; $value\n";
			$value = [];
		}
		$type = 'list-of-strings';
	} elsif ( $fldname eq 'members' )
	{	$value = Glue::HPCC::Project::PersonProject->get_members_of_project(
			$hpc, $project->name);
		unless ( $value && ref($value) )
		{	warn "Error looking up members for project " .
				$project->name . "; $value\n";
			$value = [];
		}
		$type = 'list-of-strings';
	} elsif ( $fldname eq 'coordinators' )
	{	$value = Glue::HPCC::Project::PersonProject->get_coords_of_project(
			$hpc, $project->name);
		unless ( $value && ref($value) )
		{	warn "Error looking up coords for project " .
				$project->name . "; $value\n";
			$value = [];
		}
		$type = 'list-of-strings';
	} else
	{	die "$me: Unrecognized field name '$fldname', aborting at ";
	}
	

	$value = '' unless defined $value;
	#Now format according to type, width, and/or prec

	if ( $type eq 'list-of-strings' )
	{	#Convert to 'string'
		$tmp = join ", ", @$value;
		$tmp = '' unless $tmp;
		$value = $tmp;
		$type = 'string';
	}
		
	my $text;
	if ( $type eq 'string' )
	{	#Left justify unless width starts with - or +
		if ( $width =~ /^[+-]/ )
		{ 	$text = sprintf "%${width}s", $value;
		} else
		{ 	$text = sprintf "%-${width}s", $value;
		}
	} elsif ( $type eq 'bool' )
	{	if ( $width > 5 )
		{	$tmp = ($value)?'True':'False';
		} else
		{	$tmp = ($value)?'T':'F';
		}
		#Left justify unless width starts with - or +
		if ( $width =~ /^[+-]/ )
		{ 	$text = sprintf "%${width}s", $tmp;
		} else
		{ 	$text = sprintf "%-${width}s", $tmp;
		}
	} elsif ( $type eq 'int' )
	{	$text = sprintf "%${width}d", $value;
	} elsif ( $type eq 'float' )
	{	if ( defined $prec && $prec >= 0 )
		{	$text = sprintf "%${width}.${prec}f", $value;
		} else
		{	$text = sprintf "%${width}.${prec}f", $value;
		}
	} else
	{	die "Unrecognized type $type at ";
	}

	return $text;
}

sub print_project_record($$$;$)
#Given hpc instance, list ref of field specifiers, the machine parsable flag,
#and optional project instance, print out the record.
#If no project entry given, print the header line
#HPC instance is required as some fields require additional lookups
{	my $hpc = shift;
	my $fldrecs = shift;
	my $machparsable = shift;
	my $project = shift;
	my $me = 'print_project_record';

	die "Invalid or missing hpc instance '$hpc' at "
		unless $hpc && ref($hpc);
	die "Invalid or missing fldrec list '$fldrecs' at "
		unless $fldrecs && ref($fldrecs) eq 'ARRAY';
	die "Invalid project '$project' at "
		if $project && ! ref($project);

	if ( $machparsable && ! defined $project )
	{	#Header mode in machparsable, print leading #
		print '#';
	}

	my $is_firstrec = 1;

	foreach my $fldrec (@$fldrecs)
	{	die "Illegal fldrec '$fldrec' at "
			unless $fldrec && ref($fldrec) eq 'HASH';

		if ( $is_firstrec )
		{	$is_firstrec = 0;
		} else
		{ 	if ($machparsable)
			{	print '|';
			} else
			{	print ' |';
			}
		}

		my $fldname = $fldrec->{name};
		my $title = $fldrec->{title};
		my $width = $fldrec->{width};
		$width = 0 if $machparsable;
		my $prec = $fldrec->{prec};

		if ( $project )
		{	my $text = get_project_field($hpc, $project,
				$fldname, $width, $prec);
			print "$text";
		} else
		{	#Just print title
			#Left justify always?
			$width =~ s/^[-+]//;
			my $text = sprintf "%-${width}s", $title;
			print "$text";
		}

	}
	print "\n";
}

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

my ($help, $verbose, $cluster);
$verbose=0;
my $projects = [];
my $types = [];
my $depts = [];
my $colleges = [];
my $status = 'active';
my $renewable = 0;
my $notrenewable = 0;
my $fields = [];
my $headers;
my $parents = [];

my $res = GetOptions(
	'help:s' => \$help,
	'headers!' => \$headers,
	'debug!' => \$DEBUG,
	'verbose+' => \$verbose,
	'parsable!' => \$PARSABLE,
	'cluster=s' => \$cluster,
	'fields=s' => $fields,
	'project=s' => $projects,
	'type=s' => $types,
	'dept=s' => $depts,
	'college=s' => $colleges,
	'parents=s' => $parents,
	'status=s' => \$status,
	'renewable|renewing!' => \$renewable,
	'notrenewable|notrenewing!' => \$notrenewable,
);

$help = 1 if defined $help && $help eq '';

unless ( $res )
{	usage;
	die "\nError processing options.\n";
}
if ( $help )
{	$help = lc $help;
	if ( $help eq 'fields' || $help eq 'field' )
	{	usage_fields;
		exit 0;
	}
	usage;
	exit 0;
}
if ( scalar(@ARGV) )
{	usage;
	my $tmp = join ", ", @ARGV;
	die "\nError: extraneous arguments [ $tmp ], aborting.\n";
}

#if ( $PARSABLE && ! $verbose )
#{	warn "Warning: --parsable is ignored unless --verbose.\n";
#}

if ( scalar(@$fields) )
{	if ( $verbose )
	{	warn "Warning: --verbose ignored when fields specified.\n";
	}
} else
{	#No fields specified
	if ( $verbose > 1 )
	{	$fields = [ 'verbose2' ];
	} elsif ( $verbose )
	{	$fields = [ 'verbose' ];
	} else
	{	$fields = [ 'standard' ];
	}
}

my $fldrecs = generate_fields_list($fields);

unless ( defined $headers )
{	$headers = (scalar(@$fldrecs) > 1 )?1:0;
}

if ( $renewable && $notrenewable )
{	usage;
	die "\nUseless to give both -renewable and -notrenewable.\n";
}

$status = lc $status;
my $tmp = length($status);
die "Invalid status '$status' at " unless $tmp;
$status = 'active' if $status eq substr('active', 0, $tmp);
$status = 'inactive' if $status eq substr('inactive', 0, $tmp);
$status = 'both' if $status eq substr('both', 0, $tmp);
unless ( $status eq 'active' || $status eq 'inactive' || $status eq 'both' )
{	die "Invalid status '$status' at ";
}

#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;

#Get all project entries
my $projs = Glue::HPCC::Project::Project->pdb_query($hpc);
die "No projects found.  Error???? at " unless $projs;
die "Error looking up projects: $projs at " unless ref($projs);
my %temp;

#Populate our caches
foreach my $tmprec (@$projs)
{	$_cached_project_names_by_id{$tmprec->prj_pkey} = $tmprec->name;
	$_cached_project_ids_by_name{$tmprec->name} = $tmprec->prj_pkey;
}

#If requested only specific projects, restrict to those
if ( $projects && ref($projects) eq 'ARRAY' && scalar(@$projects) )
{	%temp = map { $_ => undef } @$projects;
	$projs = [ grep { exists $temp{$_->name} } @$projs ];
	unless ( scalar(@$projs) )
	{	print "No projects matching any of [" .
			(join ", ", @$projects) . "] were found.\n";
		exit;
	}
}

my @projs = @$projs;

#Restrict based on status
if ( $status eq 'active' )
{	@projs = grep { $_->active } @projs;
} elsif ( $status eq 'inactive' )
{	@projs = grep { ! $_->active } @projs;
}


#IF requested only specific project types, restrict to those
if ( scalar(@$types) )
{	
	#my @ptypes = map { Glue::HPCC::Project::ProjectType->projecttype_by_name(
	#		$hpc,$_) } @$types;
	my @ptypes = ();
	foreach my $tmptype (@$types)
	{   my $tmp_ptype = Glue::HPCC::Project::ProjectType->projecttype_by_name(
		$hpc, $tmptype);
	    die "No project type '$tmptype' found, aborting.\n"  unless ($tmp_ptype);
	    die "Error looking project type $tmptype: $tmp_ptype.\n" 
		 unless ref($tmp_ptype);
	   push @ptypes, $tmp_ptype;
	}
	my %ptypeids = map { $_->pkey => undef } @ptypes;

	@projs = grep { exists $ptypeids{$_->projtype} } @projs;
} 

#Restrict based on renewable status
my ($tmp_ptypes, $tmp_ptids);
if ( $renewable )
{	$tmp_ptypes = 
	      Glue::HPCC::Project::ProjectType->autoreplenishing_project_types(
	      $hpc);
	$tmp_ptids = { map { $_->pkey => undef } @$tmp_ptypes };
	@projs = grep { exists $tmp_ptids->{$_->projtype} } @projs;
} elsif ( $notrenewable )
{	$tmp_ptypes = 
	      Glue::HPCC::Project::ProjectType->autoreplenishing_project_types(
	      $hpc);
	$tmp_ptids = { map { $_->pkey => undef } @$tmp_ptypes };
	@projs = grep { ! exists $tmp_ptids->{$_->projtype} } @projs;
}


#IF requested only specific departments, restrict to those
if ( scalar(@$depts) )
{	my @depts = map { Glue::HPCC::Project::Department->dept_by_code(
			$hpc, $_) } @$depts;
	#Populate our dept cache
	foreach my $tmprec (@depts)
	{	$_cached_deptrec_by_id{$tmprec->dept_pkey} = $tmprec;
	}
	
	my %deptids = map { $_->dept_pkey => undef } @depts;
	@projs = grep { $_->department && exists $deptids{$_->department} } 
		@projs;
}

#IF requested only specific colleges, restrict to those
if ( scalar(@$colleges) )
{	my @colleges = map { Glue::HPCC::Project::College->college_by_code(
			$hpc, $_) } @$colleges;
	#Populate our college cache
	foreach my $tmprec (@colleges)
	{	$_cached_college_by_id{$tmprec->coll_pkey} = $tmprec->code;
	}
	my @collegeids = map { $_->coll_pkey } @colleges;
	debug "Looking for collegeids [", (join ", ", @collegeids), "]";
	my @depts2 = ();
	COLLID: foreach my $collid (@collegeids)
	{	my $tmp = Glue::HPCC::Project::Department->pdb_query(
			$hpc, college => $collid );
		next COLLID unless $tmp;
		die "Error looking up departments in college id=$collid: $tmp at "
			unless ref($tmp) eq 'ARRAY';
		push @depts2, @$tmp;
	}
	@depts2 = map { $_->dept_pkey } @depts2;
	debug "Looking for deptids [", (join ", ", @depts2), "]";
	my %deptids2 = map { $_ => undef } @depts2;
	@projs = grep { exists $deptids2{$_->department} } @projs;
}

#Restrict by parents, if so requested
if ( scalar(@$parents) )
{	my $has_none = scalar(grep { $_ eq 'NONE' } @$parents);
	my $has_any = scalar(grep { $_ eq 'ANY' } @$parents);
	my @parents = grep { $_ ne 'NONE' && $_ ne 'ANY' } @$parents;

	if ( $has_none && $has_any )
	{	#Nothing to do
		warn "Specifying --parent ANY and --parent NONE does not do anything";
	} elsif ( $has_any )
	{	#Just return projects with any parent
		@projs = grep { defined $_->parent } @projs;
	} else
	{	#No ANY, so restrict to named parents (+ possibly NONE)
		my @parent_ids = map { get_project_id_from_name($hpc, $_) } @parents;
		@parent_ids = grep { defined $_ } @parent_ids;
		my %parent_ids = map { $_ => undef } @parent_ids;

		my @parentless_projs = grep { ! defined $_->parent } @projs;
		@projs = grep { defined $_->parent && exists $parent_ids{$_->parent} } @projs;
		push @projs, @parentless_projs if $has_none;
	}
}

unless ( scalar(@projs) )
{	print "*** No projects found in $cluster meeting requested criteria\n";
	exit;
}


#Print headers
print_project_record($hpc, $fldrecs, $PARSABLE) if $headers;

my $proj;
@projs = sort { $a->name cmp $b->name } @projs;

PROJECT: foreach $proj (@projs)
{	
	print_project_record($hpc, $fldrecs, $PARSABLE, $proj);
	next PROJECT;
}
