#! /usr/bin/perl -w
#
#  This script distributes the standard monitors evenly over a pool of
#  processing nodes. 
#
#  The command syntax is:
#
#     procsetup [--file:<file-base>] [--debug:<dbg-level>]
#
#
#  Input files:
#  A) Input file format
#     The procesetup input files consist of lines comprised of one or more
#     fields separated by blanks or tabs. Fields containing white-space 
#     characters should be enclosed in braces ("{}"). The configuration line 
#     may be continued over multiple text lines by ending a non-terminal 
#     line with a backslash (\). Comments start with a hash-mark (#) and 
#     continue to the end of the line. 
#
#  B) Compute node list file
#     This file contains one configuration line for each processing node 
#     be configured. The configuration line contains the following fields:
#
#       1) Node name
#       2) Number of CPUs
#       3) CPU speed
#       4) List of properties (comma separated)
#
#     The command line may contain symbols or escape sequences
#     as allowed by the process manager. The properties listed are used
#     as symbols in the ProcList constraint expressions. One or more sets
#     of default properties may be set by specifying a node named "default".
#     The defaults remain in effect for all nodes defined after the default
#     definition, until another default definition is encountered.
#
#  C) Process list file.
#     The ProcList file contains one configuration line for each process to
#     be run. The configuration line contains the following fields:
#
#       1) Process name
#       2) CPU usage
#       3) Command to be executed by the process
#       4) Node assignment constraints
#       5) Procmgr tag
#       6) Files used by the process
#
#    The "node assignment constraints" field is a perl expression that 
#    evaluates to true if the process may be run on a given node. The
#    symbols in this expression are substituted with values defined in
#    the node list on a node-by-node basis.
#
#  D) Run file header
#     The Run file header contains a standard list of processes to be
#     included at the start of each node run file. The format of the
#     header file is the same as that of a procmgt run file.
#
#  The output files are:
#    1) One Run list per node.
#
#  Internal storage
#  NodeList
#    0) Node name (or "default")
#    1) Number of processors
#    2) Processor speed
#    3) parameters (as "par1=value1)
#    4) assigned load
#  ProcList
#    0) Process name
#    1) Process cp requirement
#    2) process command as "cmd args..."
#    3) process constraints "{expr1 && ... && exprn}"
#    4) procmgt tags as "procmgr{-cd:xxx -when:xxx}"
#    5) process file list as "files{file-1,file-2,...,file-n}"
#    6) assigned node
#
#--- Define Phase subroutines
#
sub GetNodes; sub getFileName; sub procParse; sub tStamp;
sub proc_read; sub assign_process; sub balance_loads;
#
@ProcList = ();
$nProcs = 0;
$proc_ncol=7;
@NodeList = ();
$nNodes = 0;
$nDefNodes = 0;
$node_ncol=5;
$sum_mflops=0;
$req_mflops=0;
$MaxRestart = 100;
#
#--- Do initialization
#
$|=1;  #autoflush

$Node = `uname -n`;
chomp $Node;

$Debug = (grep(/--debug/, @ARGV))[0];
if (defined($Debug)) {
    $Debug = 1;
}else {
    $Debug = 0;
}

$FileBase = (grep(/--file:/, @ARGV))[0];
if (defined($FileBase)) {
    $FileBase =~ s/--file://;
} else {
    $FileBase = "$ENV{DMTHOME}/$ENV{DMTVERSION}/etc/procmgt";
}

$OutBase = (grep(/--out-file:/, @ARGV))[0];
if (defined($OutBase)) {
    $OutBase =~ s/--out-file://;
} else {
    $OutBase = $FileBase;
}

print (tStamp(), " --------------------------------  read node list\n");
GetNodes();
if ($nNodes <= $nDefNodes) {
    print(tStamp(), " Error: No execution nodes defined.\n");
    exit(1);
} 

print (tStamp(), " --------------------------------  read process list\n");
GetProcs();
if ($req_mflops > $sum_mflops) {
    print(tStamp(), 
	  " Error: requested CPU ($req_mflops) > available ($sum_mflops)\n"
	  );
    exit(1);
} else {
    $load_factor = $req_mflops / $sum_mflops;
    print(tStamp(), " Requested load factor: $load_factor\n");
}

#---------------------------------------  Calculate load for each processor
print (tStamp(), " --------------------------------  Calculate match table\n");
@NodeStat = ();
for (my $i=0; $i<@ProcList; $i+=$proc_ncol) {
    my $pName = $ProcList[$i];
    my $pCond = $ProcList[$i+3];
    $pCond =~ s/\s*==\s*\"/ eq \"/g;
    print "Process: $pName Condition: $pCond\n" if ($Debug);

    #-----------------------------------  Build node loads
    my @defargs="";
    for (my $j=0; $j<@NodeList; $j+=$node_ncol) {
	my $load = "na";
	if ($NodeList[$j] eq "default") {
	    @defargs = split(/,/, $NodeList[$j+3]);
	} elsif ($ProcList[$i+1] < $NodeList[$j+2]) {
	    if ($pCond ne "") {
		my @argList = split(/,/, $NodeList[$j+3]);
		push(@argList, "node=$NodeList[$j]");
		push(@argList, @defargs);
		my $cond = $pCond;
		for (my $k=0; $k<@argList; $k++) {
		    if ($argList[$k] =~ /([a-z][a-z_0-9]*)=(.+)/) {
			my $vbl = $1;
			my $val = $2;
			$cond =~ s/\$$vbl/$val/g;
		    }
		}
		$load = $ProcList[$i+1] / ($NodeList[$j+1] * $NodeList[$j+2])
		    if ( eval($cond) );
	    } else {
		$load = $ProcList[$i+1] / ($NodeList[$j+1] * $NodeList[$j+2]);
	    }
	}
	$load = int($load * 100 + 0.5) / 100 if ($load ne "na");
	push(@NodeStat, $load);
	print("Load of $pName on node $NodeList[$j]: $load\n") if ($Debug);
    }
}

print (tStamp(), " --------------------------------  Assign processes\n");
#---------------------------------------  Assign process with constraints
print (tStamp(), " Pass I: Assign processes with dependencies\n");
for (my $i=0; $i<@ProcList; $i+=$proc_ncol) {
    assign_process($i) if ($ProcList[$i+3] ne "" && $ProcList[$i+6] eq "");
}

#---------------------------------------  Assign the rest
print (tStamp(), " Pass II: Assign all remaining processes\n");
for (my $i=0; $i<@ProcList; $i+=$proc_ncol) {
    assign_process($i) if ($ProcList[$i+6] eq "");
}

#---------------------------------------  Reassign processes to balance loads
if ($nNodes-$nDefNodes > 1) {
   print (tStamp()," --------------------------------  Balance loads\n");
   balance_loads();
} else {
   print (tStamp()," --------------------------------  Too few nodes to balance\n");
}

#---------------------------------------  Generate files for each node
print (tStamp()," --------------------------------  Generate procmgr files\n");
for (my $i=0; $i<@NodeList; $i+=$node_ncol) {
    my $node = $NodeList[$i];
    next if ($node eq "default");
    my $file = "${OutBase}_Run.$node";
    if (-f "${FileBase}_RunHeader") {
	system("cp ${FileBase}_RunHeader $file");
    } elsif (-f "$file") {
	print(tStamp(), " Removing existing file: $file\n");
	unlink("$file");
    }
    open(RunFile, ">>$file");
    print(RunFile "#  Generated by procsetup for node $node ",tStamp(),"\n");
    print(RunFile "#\n");
    print(tStamp(), " ${node}: ");
    for (my $j=0; $j<@ProcList; $j+=$proc_ncol) {
	next if ($ProcList[$j+6] ne $node);
	print("$ProcList[$j] ");
	print(RunFile "-name:$ProcList[$j] $ProcList[$j+4] \\\n");
	print(RunFile "\t$ProcList[$j+2]\n");
	print(RunFile "#\n");
    }
    print("\n");
    close(RunFile);
    print(tStamp(), " Load on ${node}: $NodeList[$i+4]\n");
}

#===========================================================================
#
#    Subroutine:  GetNodes
#
#    Arguments:   none
#
#    Returns:     Error code
#
#    Purpose:     Read list of nodes.
#
#===========================================================================
sub GetNodes {
    my $File;
    return if (!($File = getFileName("NodeList")));
    open(NodeFile, $File);
    print (tStamp(), " Reading $File\n");
    while (defined($Line=proc_read(\*NodeFile))) {
	my @Entry=split(/\s+/, $Line);
	while (@Entry < $node_ncol) {
	    push(@Entry, " ");
	}
	print("Node Name:   $Entry[0]\n",
	      "Number CPUs: $Entry[1]\n",
	      "CPU speed:   $Entry[2]\n",
	      "Properties:  $Entry[3]\n",
	      ) if ($Debug);
	$sum_mflops += $Entry[1] * $Entry[2];
	$Entry[4] = 0.0;
	$nDefNodes++ if ($Entry[0] eq "default");
	push(@NodeList, @Entry);
    }
    close(NodeFile);
    $nNodes = @NodeList / $node_ncol;
    print (tStamp(), " Total $nNodes nodes $sum_mflops MFlops\n");
}

#===========================================================================
#
#    Subroutine:  GetNodes
#
#    Arguments:   none
#
#    Returns:     Error code
#
#    Purpose:     Read list of nodes.
#
#===========================================================================
sub GetProcs {
    my $File;
    return if (!($File = getFileName("ProcList")));
    open(ProcFile, $File);
    print (tStamp(), " Reading $File\n");
    while (defined($Line=proc_read(\*ProcFile))) {
	chomp $Line;
	$Line =~ s/(\s)+/ /g;
	my @Entry = ();
	while (! $Line =~ /^\s*$/) {
	    $Line =~ s/^ //;
	    if ($Line =~ s/^\{([^\}]*)\}// ) {
		push(@Entry, "$1");
	    } else {
		$Line =~ s/^([^ ]+)//;
		push(@Entry, "$1");
	    }
	}
	while (@Entry < $proc_ncol) {
	    push(@Entry, "");
	}
	if ($Debug) {
	    print("-------------------------------------\n") if (@ProcList==0);
	    print("Process Name: $Entry[0]\n",
		  "CPU reqired:  $Entry[1]\n",
		  "Command:      $Entry[2]\n",
		  "Constraints:  $Entry[3]\n",
		  "Tags:         $Entry[4]\n",
		  "Files:        $Entry[5]\n",
		  );
	    print("-------------------------------------\n");
	}
	$req_mflops += $Entry[1];
	push(@ProcList, @Entry);
    }
    close(ProcFile);
    $nProcs = @ProcList / $proc_ncol;
    print (tStamp(), " Total $nProcs processes $req_mflops MFlops\n");
}

#===========================================================================
#
#    Assign the specified process to a node.
#
#===========================================================================
sub assign_process {
    my $pinx = $_[0];
    my $r = ($pinx / $proc_ncol) * $nNodes;
    my $min_node = -1;
    my $min_load = "na";
    for (my $i=0; $i<$nNodes; $i++) {
	next if ($NodeStat[$r+$i] eq "na");
	my $ninx = $i * $node_ncol;
	my $test = $NodeList[$ninx+4] + $NodeStat[$r+$i];
	if ($min_node < 0) {
	    $min_node = $i;
	    $min_load = $test;
	} elsif ($min_load > $test) {
	    $min_node = $i;
	    $min_load = $test;
	}
    }
    if ($min_node >= 0) {
	my $ninx = $min_node * $node_ncol;
	my $load = $NodeStat[$r+$min_node];
	my $node = $NodeList[$ninx];
	$ProcList[$pinx+6]  = $node;
	$NodeList[$ninx+4] += $load;
	print("Process $ProcList[$pinx]($load) assigned to ",
	      "node $node($NodeList[$ninx+4])\n") if ($Debug);
    } else {
	print(tStamp(), " Unable to assign process $ProcList[$pinx]\n");
    }
}


#===========================================================================
#
#    Subroutine:  Balance_loads
#
#    Arguments:   none
#
#    Returns:     Error code
#
#    Purpose:     Balance the 
#
#===========================================================================
sub balance_loads {
    my $opt_found=1;
    while ($opt_found) {
	$opt_found=0;

	#-------------------------------  Find nodes with min and max  load
	my $SumSq = 0;
	my $SumLd = 0;
	my $SumN  = 0;
	my $min_inx = -1;
	my $min_load = 0;
	my $max_inx = -1;
	my $max_load = 0;
	for (my $i=0; $i<@NodeList; $i+=$node_ncol) {
	    next if ($NodeList[$i] eq "default");
	    my $load = $NodeList[$i+4];
	    $SumSq += $load * $load;
	    $SumLd += $load;
	    $SumN++;
	    if ($min_inx < 0 || $load < $min_load) {
		$min_inx  = $i;
		$min_load = $load;
	    }
	    if ($max_inx < 0 || $load > $max_load) {
		$max_inx  = $i;
		$max_load = $load;
	    }
	}
	my $OptParam = 100 * ($SumSq * $SumN / ( $SumLd * $SumLd) - 1);
	print(tStamp(), " Optimization parameter (Sum load^2): $OptParam\n");
	my $min_id = $min_inx / $node_ncol;
	my $max_id = $max_inx / $node_ncol;
	my $mmx_sum = ($min_load * $min_load) + ($max_load * $max_load);
	
	#-------------------------------  Look to Move a process
	my $id1 = -1;
	my $sum1 = 0;
	for (my $i=0; $i<@ProcList; $i+=$proc_ncol) {
	    next if ($ProcList[$i+6] ne $NodeList[$max_inx]);
	    my $inx = ($i/$proc_ncol)*$nNodes;
	    next if ($NodeStat[$inx+$min_id] eq "na");
	    my $lmin = $min_load + $NodeStat[$inx+$min_id];
	    my $lmax = $max_load - $NodeStat[$inx+$max_id];
	    my $test = ($lmin * $lmin) + ($lmax * $lmax);
	    print("Test move $ProcList[$i]: $test\n") if ($Debug);
	    if (($id1 < 0 && $test < $mmx_sum) || $test < $sum1) {
		$id1  = $i;
		$sum1 = $test;
	    }
	}
	if ($id1 >= 0) {
	    $ProcList[$id1+6] = $NodeList[$min_inx];
	    my $inx = ($id1/$proc_ncol)*$nNodes;
	    $NodeList[$min_inx+4] += $NodeStat[$inx+$min_id];
	    $NodeList[$max_inx+4] -= $NodeStat[$inx+$max_id];
	    print("Move $ProcList[$id1], $NodeList[$max_inx] -> ",
		  "$NodeList[$min_inx]\n") if ($Debug);
	    $opt_found=1;
	    next;
	}

	#-------------------------------  Look for process swap.
	my $jd1 = -1;
	for (my $i=0; $i<@ProcList; $i+=$proc_ncol) {
	    next if ($ProcList[$i+6] ne $NodeList[$min_inx]);
	    my $inx = ($i/$proc_ncol)*$nNodes;
	    next if ($NodeStat[$inx+$max_id] eq "na");
	    for (my $j=0; $j<@ProcList; $j+=$proc_ncol) {
		next if ($ProcList[$j+6] ne $NodeList[$max_inx]);
		my $jnx = ($j/$proc_ncol)*$nNodes;
		next if ($NodeStat[$jnx+$min_id] eq "na");
		my $lmin=$min_load+$NodeStat[$jnx+$min_id]-$NodeStat[$inx+$min_id];
		my $lmax=$max_load+$NodeStat[$inx+$max_id]-$NodeStat[$jnx+$max_id];
		my $test = ($lmin * $lmin) + ($lmax * $lmax);
		print("Test swap $ProcList[$i] <-> $ProcList[$j]: $test\n") 
		    if ($Debug);
		if (($id1 < 0 && $test + 1e-6 < $mmx_sum) || $test < $sum1) {
		    $id1  = $i;
		    $jd1  = $j;
		    $sum1 = $test;
		}
	    }
	}
	if ($id1 >= 0) {
	    $ProcList[$id1+6] = $NodeList[$max_inx];
	    $ProcList[$jd1+6] = $NodeList[$min_inx];
	    my $inx = ($id1/$proc_ncol)*$nNodes;
	    my $jnx = ($jd1/$proc_ncol)*$nNodes;
	    $NodeList[$min_inx+4]+=$NodeStat[$jnx+$min_id]-$NodeStat[$inx+$min_id];
	    $NodeList[$max_inx+4]+=$NodeStat[$inx+$max_id]-$NodeStat[$jnx+$max_id];
	    print("Swap $ProcList[$id1] to $NodeList[$max_inx] & ",
		  "$ProcList[$jd1] to $NodeList[$min_inx]\n") if ($Debug);
	    $opt_found=1;
	}

    #-----------------------------------  End of iteration
    }
}

#===========================================================================
#
#    Get the creation date of the specified file
#
#===========================================================================
sub getFileDate {
    my @pStat=lstat("$_[0]");
    return $pStat[10];
}

#===========================================================================
#
#   Get a file name
#
#===========================================================================
sub getFileName {
    my $File;
    $File = "${FileBase}_$_[0].$Node";
    print "Try file $File\n" if ($Debug);
    return $File if (-e $File);
    $File = "${FileBase}_$_[0]";
    print "Try file $File\n" if ($Debug);
    return $File if (-e $File); 
    print "No valid file for Phase $_[0]\n";
    return 0;
}

#===========================================================================
#
#    Subroutine:  procParse
#
#    Arguments:   A process list command line
#
#    Returns:     A list comprising a process entry.
#
#    Purpose:     Parse a process definition line. The process definition 
#                 parsed and a process entry is produced. The general form
#                 for a process definition is as follows:
#                     [-name:<name>] [-when:<when-condition>] 
#                                    [-cd:<directory>] [-log[:<log-file>]] 
#                                    [-nlives:<n-restart>]
#                                    <command>
#                 where:
#                     <name>           the process name
#                     <when-condition> an sh command which if it evaluates 
#                                      to 0 (no error) will enable the 
#                                      process to be run.
#                     <log-file>       a log file into which the standard
#                                      output will be copied. If -log is
#                                      specified without a file name, the 
#                                      $HOME/logs/<name>-%t.log is used.
#                     <n-restart>      Number of restarts
#                     <command>        the shell command to be executed.
#
#===========================================================================
sub procParse {
    my $Line = $_[0];
    return () if (! length($Line));
    $Line =~ s/\s(\s*)/ /g;
    $Line =~ s/^ //;
    while($Line =~ s/"(.*?) (.*?)"/"$1#$2"/g) {}
    $Line =~ s/"(.*?)"/$1/g;
    my @List = split(/ /,$Line);
    for (my $i=0 ; $i < @List ; $i++) {
	$List[$i] =~ s/#/ /g;
    }
    my $Wait   = 0;
    my $Name   = "";
    my $Log    = "";
    my $When   = "";
    my $Resets = $MaxRestart;
    my $Cwd    = "$ENV{DMTSTORE}/pars";
    while ($List[0] =~ "^-") {
	my $Key = shift(@List);
	print "Key: $Key \n" if($Debug);
	if ($Key eq "-wait") {
	    $Wait |= 1;
	} elsif ($Key eq "-hup") {
	    $Wait |= 2;
	} elsif ($Key =~ "^-cd:") {
	    $Cwd = substr($Key, 4);
	} elsif ($Key =~ "^-name:") {
	    $Name = substr($Key, 6);
	} elsif ($Key =~ "^-nlives:") {
	    $Resets = substr($Key, 8);
	} elsif ($Key =~ "^-when:") {
	    $When = substr($Key, 6);
	} elsif ($Key eq "-log") {
	    $Log = "<default>";
	} elsif ($Key =~ "^-log:") {
	    $Log = substr($Key, 5);
	} elsif ($Key =~ "^-no-output:") {
	    my @OutList = split(':', substr($Key, 11));
	    $Wait |= 0x04 if (scalar(grep(/trend/, @OutList)) > 0);
	    $Wait |= 0x08 if (scalar(grep(/html/,  @OutList)) > 0);
	    $Wait |= 0x10 if (scalar(grep(/data/,  @OutList)) > 0);
	} elsif ($Key eq "-no-output") {
	    $Wait |= 0x1c;
	} else {
	    warn "Unidentified option: $Key\n";
	    return ();
	}
    }
    my $Cmd = join(' ', @List);
    if (! $Name) {
	$Name = $List[0];
	$Name =~ s|.*/||g;
	print "Process assigned name $Name \n" if ($Debug);
    }
    $Log = "\$DMTSTORE/logs/${Name}-\%t.log" if ($Log eq "<default>");
    return ($Name, $Cmd, 0, $Resets, $Log, $Wait, $When, 0, $Cwd);
}

#===========================================================================
#
#    Subroutine:  tStamp
#
#    Arguments:   none
#
#    Returns:     The current time formatted in a standard way
#
#    Purpose:     Get the current time to be used as a time stamp for the
#                 Log file.
#
#=======================================  Generate a time stamp
sub tStamp {
    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime();
    $year += 1900;
    $mon  += 1;
    return sprintf("%d.\%02d.\%02d-\%02d.\%02d.\%02d", 
		   $year, $mon, $mday,$hour, $min, $sec);
}

#===========================================================================
#
#   Read a line from the specified file handle. Comment lines starting
#   with a '#' are ignored and a trailing '\' indicates that the line 
#   is continued.
#
#   p0 - reference to the file handle
#
#===========================================================================
sub proc_read {
    my $fh = $_[0];
    my $Line; my $Cont;
    while (defined($Line=<$fh>) && $Line =~ /^#/) {}
    return undef if (!defined($Line));
    chomp $Line;
    while ($Line =~ s/\\$//) {
	if (defined($Cont=<$fh>)) {
	    chomp $Cont;
	    $Line .= $Cont;
	} else {
	    last;
	}
    }
    return $Line;
}
