#!/usr/local/bin/perl
#
#Script to list project types 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 Getopt::Long;
use Text::Wrap;

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

Usage:
$0 [ -desc | -flags | -csv] [ -cluster CLUSTER ]

List projects types defined in project DB for a 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).

Normally, just lists the project type names.  If -desc given,
the (usually long) description will be listed with each project type.
If -flags given, give the names and the various settings for each
project type.  -desc and -flags try to be human readable; --csv will 
give all that info, but in csv format.


EOF
}

sub dump_desc(;$)
{	my $ptype = shift;

	my $fmt = "%-12s %s\n";
	unless ( $ptype )
	{	#Print header
		printf $fmt, "PType Name", "Description";
		return;
	}

	my $name = $ptype->name;
	my $desc = $ptype->description;
	$Text::Wrap::columns=60;
	$desc = wrap('','',$desc);
	my @desc = split /\n/, $desc;

	foreach $desc (@desc)
	{	printf $fmt, $name, $desc;
		$name = '';
	}
}

sub vertical_header(@)
{	my $fmt = shift;
	my @fields = @_;

	my $max = 0;
	my $hdr;
	my $tmp;
	foreach $hdr (@fields)
	{	if ( ref($hdr) eq 'ARRAY' )
		{	$tmp = scalar(@$hdr);
		} else
		{	$tmp = length($hdr);
		}
		$max = $tmp if $tmp > $max;
	}

	my $line;
	foreach $line ( 0 .. $max-1 )
	{	my @line_header = ();
		foreach $hdr (@fields)
		{	if ( ref($hdr) eq 'ARRAY' )
			{	$tmp = $hdr->[$line] || '';
			} else
			{	if ( length($hdr) > $line )
				{	$tmp = substr($hdr, $line, 1);
				} else
				{	$tmp = '';
				}
			}
			push @line_header, $tmp;
		}
		printf $fmt, @line_header;
	}
}

sub dump_flags(;$)
{	my $ptype = shift;

	my $fmt = "%-12s %-8s %-4s" . ( " %1s" x 9 ) . "\n";

	unless ( $ptype )
	{	vertical_header($fmt, 
			[ 'Project', 'Type', 'Name' ],
			[ 'QoS', 'Tag' ],
			[ 'Def', 'Exp', '(in', 'days', ')' ],
			'Replenish?', 
			'NormalPri?',
			'HighPrio?',
			'SpecPart?',
			'Scavenger?',
			'DebugQ?',
			'ReqUnxGrp?',
			'Members?',
			'Metered?',
		);
		return;
	}

	my $name = $ptype->name;
	my $qostag = $ptype->qos_tag || 'NULL';
	my $defexp = $ptype->default_expiry_days;

	my $replenishes = $ptype->auto_replenishes?'Y':'n';
	my $normal = $ptype->has_normal_priority?'Y':'n';
	my $high = $ptype->has_high_priority?'Y':'n';
	my $special = $ptype->has_special_partition?'Y':'n';
	my $scavenger = $ptype->can_use_scavenger_q?'Y':'n';
	my $debug = $ptype->can_use_debug_q?'Y':'n';
	my $unxgrp = $ptype->requires_unix_group?'Y':'n';
	my $members = $ptype->can_have_members?'Y':'n';
	my $metered = $ptype->is_metered?'Y':'n';

	printf $fmt, $name, $qostag, $defexp, 
		$replenishes, $normal, $high,
		$special, $scavenger, $debug,
		$unxgrp, $members, $metered;
}

sub dump_csv(;$)
{	my $ptype = shift;

	my @fields = qw(
		name
		description
		auto_replenishes
		has_normal_priority
		has_high_priority
		has_special_partition
		can_use_scavenger_q
		can_use_debug_q
		default_expiry_days
		requires_unix_group
		can_have_members
		qos_tag
		is_metered
	);

	my $str;
	unless ( $ptype )
	{	$str = join "|", @fields;
		print "#$str\n";
		return;
	}

	my $field;
	$str = '';
	foreach $field (@fields)
	{	my $meth = $field;
		my $val = $ptype->$meth;
		if ( $field eq 'auto_replenishes' ||
			$field =~ /^has_/ || $field =~ /^can_/ ||
			$field =~ /^is_/ || $field =~ /^requires_/ )
		{	#Boolean value
			$val = $val?1:0;
		}

		$val = '' unless defined $val;

		$str .= '|' if $str;
		$str .= $val;
	}
	print "$str\n";
}


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

my ($help, $cluster);
my ($do_desc, $do_flags, $do_csv);

my $res = GetOptions(
	'help!' => \$help,

	'description!' => \$do_desc,
	'flags!' => \$do_flags,
	'csv!' => \$do_csv,
);

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

if ( ( $do_desc && $do_flags ) || ( $do_desc && $do_csv ) ||
	( $do_flags && $do_csv ) )
{	usage;
	die "\nError: --desc, --flags, and --csv are mutually exclusive.\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;

#Get all project types
my $ptypes = Glue::HPCC::Project::ProjectType->pdb_query($hpc);
die "No project types found.  Error???? at " unless $ptypes;
die "Error looking up project types: $ptypes at " unless ref($ptypes);

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

if ( $do_desc )
{	dump_desc();
} elsif ( $do_flags )
{	dump_flags();
} elsif ( $do_csv )
{	dump_csv();
}

foreach my $ptype (@ptypes)
{	if ( $do_desc )
	{	dump_desc($ptype);
	} elsif ( $do_flags )
	{	dump_flags($ptype);
	} elsif ( $do_csv )
	{	dump_csv($ptype);
	} else
	{	print $ptype->name,"\n";
	}
}
