#!/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 "/cell_root/software/HPCC/1.1/lib/site_perl";

use Glue::HPCC::Cluster;
use Glue::HPCC::Project::Log;

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

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

Usage:
$0 [ -dbcluster DBCLUSTER ] \
	[ -user USER ] [ -program PROGRAM ] [ -host HOST ] \
	[ -starttime STARTTIME ] [ -endtime ENDTIME ] \
	[ -reason REASON ] [ -description DESC ] [ -action-code ACTIONCODE ] \
	[ -project PROJECT ] [ -account ACCOUNT ] [ -cluster CLUSTER ] \
	[ -person UNAME ] [ -tablename TABLE ] [ -field FIELD ] \
	[ -oldval OLD ] [ -newval NEW ] [ --fuzzy ] [ -all ]

DBCLUSTER is the cluster to use for determining which DB to attach to.
It will be defaulted from hostname.  If given, cannot be repeated.

This will dump all log entries found matching the specified criteria.  If
a class of criteria is repeated, a log entry will match that criteria class if
it matches any of the values.  Values for different criteria classes are ANDed.
If a value is not given for a particular class, it is ignored.

USER, PROGRAM, and HOST refer to who made the change (i.e. the sysadmin).
Only log entries between STARTTIME and ENDTIME are considered; these fields
may NOT be repeated, and default to beginning and end of time.

All matches must be exact, unless --fuzzy is given.  If fuzzy is given, and
a value has any non-alphanumeric characters, it will be interpretted as a
regular expression.  Note: processing of --fuzzy matches occurs in perl, not
in SQL, so can take much longer.

At least one criterion must be given, or the flag -all if you really want
all records to be dumped.

If --debug is given, SQL will be displayed.

EOF
}

sub add_fuzzy_nonfuzzy_criteria($$$$$)
#Takes hash refs for fuzzy and nonfuzzy criteria, the fuzzy flag, a
#field name, and its list ref of values.
#Adds to the fuzzy/nonfuzzy criteria hash if values set.  Which hash gets
#added to depends on fuzzy flag and values.
{	my $fhash = shift;
	my $nfhash = shift;
	my $fuzzy = shift;
	my $field = shift;
	my $values = shift;

	#Nothing to do unless given a field and some values
	return unless $field;
	return unless $values && ref($values) eq 'ARRAY' && scalar(@$values);

	unless ( $fuzzy )
	{	#Not much to do unless $fuzzy set
		$nfhash->{$field} = $values;
		return;
	}

	#Are there any non-alpha numeric values in @$values?
	my @temp = grep /\W/, @$values;
	if ( @temp )
	{	$fhash->{$field} = $values;
	} else
	{	$nfhash->{$field} = $values;
	}
	return;
}

#Recursive function
sub cross_product_hash_keys($);
sub cross_product_hash_keys($)
#Takes a hash ref, values of keys are array refs.
#Returns cross product; e.g. { a => [ 1,2,3], b=>[4,5] } would return something
#like
#[	{ a=>1, b=4 }, {a=>1, b=>5} , 
#	{ a=>2, b=4 }, {a=>2, b=>5} , 
#	{ a=>3, b=4 }, {a=>3, b=>5} , 
#]
#i.e., we enumerate over all values	
{	my $hash = shift || {};

	return $hash unless scalar(%$hash); #Emtpy hash => empty hash

	my @keys = keys %$hash;
	my ($key, $vals);
	my @hashes;

	if ( scalar(@keys) == 1 )
	{	$key = $keys[0];
		$vals = $hash->{$key};
		@hashes = map { { $key => $_ } } @$vals;
		return \@hashes;
	}

	#More than 1 key, recurse
	$key = shift @keys;
	my $tmphash = { %$hash };
	$vals = delete $tmphash->{$key};

	my $hashes = cross_product_hash_keys($tmphash);
	@hashes = ();
	foreach my $val (@$vals)
	{	foreach my $tmphash (@$hashes)
		{	push @hashes, { %$tmphash, $key=>$val };
		}
	}
	return \@hashes;
}

sub get_nonfuzzy_matches($$)
#Given an Glue::HPCC::Cluster instance and a hash ref (possibly empty) of
#search criteria (in ARRAY refs, might be multiple values to OR against)
#return a list ref of matching Glue::HPCC::Project::Log entries
{	my $hpc = shift;
	my $criteria = shift;
	my $me = 'get_nonfuzzy_matches';

	die "$me: Missing hpc object at " unless $hpc;
	die "$me: Invalid hpc object '$hpc' at " unless ref($hpc);
	die "$me: Invalid criteria '$criteria' at " 
		unless $criteria && ref($criteria) eq 'HASH';

	my $time = delete $criteria->{time};
	my $start = delete $criteria->{starttime};
	my $end = delete $criteria->{endtime};
	if ( $start || $end )
	{	die "$me: Cannot specify both 'time' & 'starttime/endtime' at "
			if $time;
		$time = [ $start, $end ];
		$criteria->{time} = $time;
	}

	my $recs = Glue::HPCC::Project::Log->pdb_query($hpc, %$criteria);

	return $recs;
}

sub do_fuzzy_match_field_value($$$)
#Returns list ref of all records in list ref $recs for which field $field
#fuzzily matches $regexp
{	my $recs = shift || [];
	my $field = shift;
	my $regexp = shift;
	my $me = 'do_fuzzy_match_field_value';

	my @recs = ();
	RECORD: foreach my $rec (@$recs)
	{	my $val = $rec->$field;
		next RECORD unless defined $val;
		if ( $val =~ /$regexp/ )
		{	push @recs, $rec;
		}
	}
	return \@recs;
}

sub do_fuzzy_matching($$)
#Given a list ref of matching log records, and a hash ref of criteria to
#be matched 'fuzzily', we return the subset of log records which match the
#fuzzy criteria
{	my $recs = shift || [];
	my $fuzzy = shift || {};

	return $recs unless $recs && ref($recs) eq 'ARRAY' && scalar(@$recs);
	return $recs unless $fuzzy && ref($fuzzy) eq 'HASH' && scalar(%$fuzzy);

	my @recs = ();
	my @keys = keys %$fuzzy;
	foreach my $key (@keys)
	{	my $vals = $fuzzy->{$key};
		foreach my $val (@$vals)
		{ 	my $tmp = do_fuzzy_match_field_value($recs, $key, $val);
			push @recs, @$tmp if $tmp && ref($tmp) eq 'ARRAY';
		}
	}

	#Remove duplicates
	my %temp = map { $_->log_pkey => $_ } @recs;
	@recs = values %temp;
	return \@recs;
}

sub dump_logrec(;$)
#Dump a log record
{	my $log = shift;

	my $fmt = "%30s %16s %20s %25s %s\n";
	unless ( $log )
	{	printf $fmt,
			"user(program)", "Date/Time", "Action", "Reason",
			"Desc";
		return;
	}

	my $user = $log->username || '';
	my $host = $log->hostname || '';
	$host =~ s/\.umd\.edu//;
	my $program = $log->program || '';
	my $ustr = "${user}($program)";

	my $time = $log->time;
	my $tstamp = parsedate($time) if $time;
	my $tstr = strftime("%Y-%m-%d %H:%M", localtime($tstamp));

	my $action = $log->action_code;
	my $reason = $log->reason;

	my $desc = $log->description || '';
	my $proj = $log->project;
	my $acc  = $log->account;
	my $clus = $log->cluster;
	my $who  = $log->person;
	my $table= $log->tablename;
	my $field= $log->fieldname;
	my $oldval=$log->oldval;
	my $newval=$log->newval;

	my $tmpstr = '';
	my $sep='';
	my $newsep = ', ';
	if ( $proj )
	{	$tmpstr .= $sep . "Prj=$proj";
		$sep = $newsep;
	}
	if  ( $acc )
	{	$tmpstr .= $sep . "Acc=$acc";
		$sep = $newsep;
	}
	if  ( $clus )
	{	$tmpstr .= $sep . "Cl=$clus";
		$sep = $newsep;
	}
	if  ( $who )
	{	$tmpstr .= $sep . "User=$who";
		$sep = $newsep;
	}
	if  ( $table )
	{	$tmpstr .= $sep . "Tab=$table";
		$sep = $newsep;
	}
	if  ( $field )
	{	$tmpstr .= $sep . "Fld=$field";
		$sep = $newsep;
	}
	if ( $oldval || $newval )
	{	$tmpstr .= $sep . "Val: ";
		if ( defined $oldval )
		{	$tmpstr .= $oldval;
		} else { $tmpstr .= "undef"; }
		$tmpstr .= ' => ';
		if ( defined $newval )
		{	$tmpstr .= $newval;
		} else { $tmpstr .= "undef"; }
	}

	my $descstr = "$desc ($tmpstr)";

	printf $fmt, $ustr, $tstr, $action, $reason, $descstr;
}
	


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

my $help;
my $all=0;
my $fuzzy=0;
my $debug;
my $dbcluster;

my $users = [];
my $programs = [];
my $hosts = [];
my ($starttime,$endtime);

my $reasons = [];
my $descs = [];
my $acodes = [];

my $projects = [];
my $accounts = [];
my $clusters = [];

my $persons = [];
my $tables = [];
my $fields = [];
my $oldvals = [];
my $newvals = [];

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

	'dbcluster=s' => \$dbcluster,

	'starttime=s' => \$starttime,
	'endtime=s' => \$endtime,

	'user=s' => $users,
	'program=s' => $programs,
	'host=s' => $hosts,

	'reason=s' => $reasons,
	'description=s' => $descs,
	'action-code|action_code|acode=s' => $acodes,

	'c|cluster=s' => $clusters,
	'p|project=s' => $projects,
	'a|ac|account=s' => $accounts,

	'person=s' => $persons,
	'table=s' => $tables,
	'fields=s' => $fields,
	'oldval=s' => $oldvals,
	'newval=s' => $newvals,
);

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";
}

#Check that we have some constraint, or -all
my $count = 0;
$count++ if $starttime;
$count++ if $endtime;
$count += scalar(@$users) + scalar(@$programs) + scalar(@$hosts);
$count += scalar(@$reasons) + scalar(@$descs) + scalar(@$acodes);
$count += scalar(@$projects) + scalar(@$clusters) + scalar(@$accounts);
$count += scalar(@$persons) + scalar(@$tables) + scalar(@$fields);
$count += scalar(@$oldvals) + scalar(@$newvals);

unless ( $count || $all )
{	usage;
	die "\nYou must specify at least one condition, or give -all for all log records.\n";
}

#Default cluster if needed
my $hpc = Glue::HPCC::Cluster->new_from_clustername($dbcluster);
die "\nError instantiating cluster $hpc\nDo you need to use --dbcluster? at  " unless $hpc && ref($hpc);
$dbcluster = $hpc->db_clustername;
$hpc->verbose($debug);

my $nonfuzzy_criteria = {};
$nonfuzzy_criteria->{starttime} = $starttime if $starttime; #Always nonfuzzy
$nonfuzzy_criteria->{endtime} = $endtime if $endtime; #Always nonfuzzy
my $fuzzy_criteria = {};
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'user', $users);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'program', $programs);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'hostname', $hosts);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'reason', $reasons);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'description', $descs);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'action_code', $acodes);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'project', $projects);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'cluster', $clusters);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'account', $accounts);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'person', $persons);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'tablename', $tables);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'fieldname', $fields);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'oldval', $oldvals);
add_fuzzy_nonfuzzy_criteria($fuzzy_criteria, $nonfuzzy_criteria, $fuzzy,
	'newval', $newvals);

#Get all log entries matching non-fuzzy criteria
my $logrecs = get_nonfuzzy_matches($hpc,$nonfuzzy_criteria);

$logrecs = do_fuzzy_matching($logrecs, $fuzzy_criteria);

unless ( $logrecs && ref($logrecs) eq 'ARRAY' && scalar(@$logrecs) )
{	print "No matching log entries.\n";
	exit 0;
}

dump_logrec();
foreach my $logrec (@$logrecs)
{	dump_logrec($logrec);
}

