#!/usr/bin/env perl
#-----------------------------------------------------------------------------------------------
#
# xmlchange
#
# This utility allows the user to change a env_*xml file via a commandline interface.
#
# The command is echoed to the CaseStatus file, unless -noecho is given. The
# purpose of this echoing is to provide a "paper trail" of changes made by the
# user, so calls to xmlchange by the cime scripts that are part of the normal case
# setup/build process should generally use -noecho.
#
#-----------------------------------------------------------------------------------------------

use strict;
#use warnings;
#use diagnostics;
use Cwd qw( getcwd abs_path chdir);
use English;
use Getopt::Long;
use IO::File;
use IO::Handle;
use File::Copy;
use XML::LibXML;

#-----------------------------------------------------------------------------------------------
sub usage {
    die <<EOF;
SYNOPSIS
     xmlchange [options] <listofsettings>
DESCRIPTION
     allows user to modify an xml file and perform consistency checks where appropriate

OPTIONS
     User supplied values are denoted in angle brackets (<>).  Any value that contains
     white-space must be quoted.  Long option names may be supplied with either single
     or double leading dashes.  A consequence of this is that single letter options may
     NOT be bundled.
REQUIRED OPTIONS

   Either provide ALL of the following options to modify a single variable...

     -file <name>         xml file to modify
                          NOTE: this is no longer utilized - but is there for backwards compatibility
     -id <name>           xml variable id
     -val <name> 	  xml new value for variable id

   Or provide the settings in a comma-delimited list form as: <listofsettings>

      var=value,var2=value2

   To set one or more variables without having to know the filename a variable is in.

   NOTE: NO-Whitespace. No spaces between commas, or in values unless you quote the
         entire string so the shell recognizes it as one thing. Also values can NOT
         contain the symbols "=" or ",".

OPTIONAL
     -subgroup           If the value is in more than one node change this one (default - change all)  Currently this supports changing values in env_batch.xml which are defined by
          the name of the job being submitted.  (run, test, st_archive, lt_archive)
     -append [or -a]      append value to the end of existing value
     -help [or -h]        Print usage to STDOUT.
     -noecho              Do NOT echo command to CaseStatus file
     -loglevel            Level of output verbosity: DEBUG, INFO, WARN, ERROR, FATAL
     -warn [or -w]        Warn and abort if you are overwriting data that is not blank

NOTE:
     You can NOT use both the warn and append modes at the same time.
EOF
}

#-----------------------------------------------------------------------------------------------
if ($#ARGV == -1) {
    print "ERROR xmlchange: no arguments sent in\n";
    usage();
}

# Setting autoflush (an IO::Handle method) on STDOUT helps in debugging.  It forces the test
# descriptions to be printed to STDOUT before the error messages start.
*STDOUT->autoflush();

my $xml = XML::LibXML->new( no_blanks => 1)->parse_file("env_case.xml");
my @nodes = $xml->findnodes(".//entry[\@id=\"CIMEROOT\"]");
my $cimeroot = $nodes[0]->getAttribute('value');

unshift @INC, "$cimeroot/utils/perl5lib";
require Config::SetupTools;
require Log::Log4perl;


# Parse command-line options.
my @saved_argv = @ARGV;

my %opts = (
    file=>undef,
    id=>undef,
    val=>undef,
    subgroup=>undef,
    loglevel => "INFO"
    );

GetOptions(
    "a|append"   => \$opts{'append'},
    "file=s"     => \$opts{'file'},
    "id=s"       => \$opts{'id'},
    "val=s"      => \$opts{'val'},
    "h|help"     => \$opts{'help'},
    "noecho"     => \$opts{'noecho'},
    "loglevel=s"  => \$opts{'loglevel'},
    "w|warn"     => \$opts{'warn'},
    "subgroup=s" => \$opts{subgroup},
)  or usage();

my $level = Log::Log4perl::Level::to_priority($opts{loglevel});
Log::Log4perl->easy_init({level=>$level,
			  layout=>'%m%n'});

my $logger = Log::Log4perl::get_logger();

# Give usage message.
usage() if $opts{'help'};

# Get the list form if anything else is set
my $settinglist = shift(@ARGV);

# Check for unparsed argumentss
if (@ARGV) {
    $logger->error( "ERROR xmlchange: unrecognized arguments: @ARGV");
    $logger->error( "A list of ID's needs to be comma-delimited with NO-WHITESPACE!");
    usage();
}

# Check for manditory case input if not just listing valid values
my %idlist;
if ( ! defined($settinglist) ) {
   foreach my $item ( "file", "id", "val" )
   {
      if ( ! defined($opts{$item}) ) {
         $logger->error( "ERROR xmlchange : Must provide $item as input argument ");
         usage();
      }
   }
   $idlist{$opts{'id'}} = $opts{'val'};
} else {
   foreach my $varval ( split( /,/, $settinglist ) ) {
       if ( $varval =~ /^(\w+)=(.*+)$/ ){
         if ( defined($idlist{$1}) ) {
            $logger->warn( "ERROR: variable $1 was already set once in the settings list: $settinglist");
         }
         $idlist{$1} = $2;
      } else {
         $logger->logdie( "ERROR xmlchange : variable = value setting is NOT recognized: $varval
                                            Should be of the form: variable = value");
      }
   }
}

# If filename is input as option - check that it is supported
my @filenames = qw(env_run.xml env_build.xml env_case.xml env_mach_pes.xml env_batch.xml env_test.xml);
if ( ! defined($settinglist) ) {
   push (@filenames, $opts{'file'});
   my $status = 0;
   foreach my $filename (@filenames)
   {
       if ($opts{'file'} eq $filename) {
	   $status = 1;
	   last;
       }
   }
   if ($status != 1) {
       my $str = "** $opts{'file'} is not an acceptable file to modify *** \n";
       $str .= "*** acceptable files are @filenames *** \n";
       $str .= "*** Note: env_archive.xml can be modified manually and checked with xmllint. *** \n";
       $str .= " *** See st_archive --help for details *** ";
       $logger->logdie($str);
   }
}

#-----------------------------------------------------------------------------------------------
# Determine the env_xxx.xml file for each required xmlchange variable
# store these in the hash %id_file
#-----------------------------------------------------------------------------------------------

my %id_file;
foreach my $id ( keys(%idlist) )
{
    foreach my $file (@filenames)
    {
	next unless(-e $file);
	# Loop over all nodes in the file
	my $xml_file = XML::LibXML->new( no_blanks => 1)->parse_file($file);
	foreach my $node ($xml_file->findnodes(".//entry[\@id=\"$id\"]"))
	{
	    # Store this in %id_file hash - this will be used below
	    $id_file{$id} = $file;

	    # Do error checking for requested change
	    my $value = $node->getAttribute('value');
	    my($type, $valid_values, $is_list_value);
	    foreach my $childnode ($node->findnodes(".//*"))
	    {
		if ($childnode->nodeName() eq 'type') {
		    $type = $childnode->textContent();
		}
		if ($childnode->nodeName() eq 'valid_values') {
		    $valid_values = $childnode->textContent();
		}
		if ($childnode->nodeName() eq 'list') {
		    $is_list_value = $childnode->textContent();
		}
	    }

	    # Determine if requested change is a value

        # If we are setting a value to another unresolved value
        # such as ./xmlchange REST_OPTION=\$STOP_OPTION,
        # we want to resolve STOP_OPTION, make sure whatever
        # it is set to is a valid_value, then set
        # $value to $unresolved_value if is_valid_values passes
        my $unresolved_value = $idlist{$id};
	    if($unresolved_value =~ m/^\$/) {
            $logger->debug("UNRESOLVED VALUE: $unresolved_value");
            my $resolved_value = SetupTools::getSingleResolved($unresolved_value);
		    $logger->debug("is_valid_value: $id, $resolved_value, $valid_values, $is_list_value");
            SetupTools::is_valid_value($id, $resolved_value, $valid_values, $is_list_value);
            $value = $unresolved_value;
        }
	    elsif ($value !~ m/^$/) {
		    my $newvalue = $idlist{$id};
		    $logger->debug("is_valid_value: $id, $newvalue, $valid_values, $is_list_value");
		    SetupTools::is_valid_value($id, $newvalue, $valid_values, $is_list_value);
	    }

	    # If append mode is on - check that variable is of the character type
	    if ($opts{'append'}) {
		if ( $type ne 'char') {
		    $logger->logdie( "ERROR xmlchange: Append mode can ONLY work on character type values.");
		}
	    }

	    # If warn mode is on, abort if data is set to something other than missing values
	    if ($opts{'warn'}) {
		if ( $type ne 'char') {
		    if ( ($value !~ m/^\s*$/) && ($value !~ m/UNSET/i) ) {
			$logger->logdie ("ERROR xmlchange: Variable $id is already set to $value.");
		    }
		} elsif ( $value != -99 && $value != -999 && $value != -999.99 ) {
		    $logger->logdie ("ERROR xmlchange : Variable $id is already set to $value.");
		}
	    }
	    last;
	}
    }
    if (! $id_file{$id}) {
	$logger->logdie ("ERROR xmlchange: variable $id is not a valid name ");
    }
}

#-----------------------------------------------------------------------------------------------
# Now overwrite all the necessary files that contain variables that must be modified
# Before overwriting the file, make a backup copy in case  there are file system problems,
# this way the original xml file does not get corrupted.
#-----------------------------------------------------------------------------------------------

foreach my $file (values (%id_file))
{
    # Create backup file
    my $backupfile = "$file.bak";
    copy($file, $backupfile) or $logger->logdie ("A problem occurred copying $file to $backupfile, reason was $!");

    # Write out the file header
    my $xml = XML::LibXML->new( no_blanks => 1)->parse_file($file);

    my $fh = IO::File->new($file, '>' ) or $logger->logdie ("can't open file: $file");
    print $fh "<?xml version=\"1.0\"?> \n";
    print $fh "\n";
    print $fh "<config_definition> \n";
    print $fh "\n";

    my @nodes_header = $xml->findnodes(".//header");
    if ($#nodes_header == 0)  {
	my $header_text = $nodes_header[0]->textContent();
	print $fh "<header>";
	print $fh "$header_text";
	print $fh "</header> ";
    }

    # Write out the groups contained in the file
    print $fh "\n\n";
    print $fh "<groups>\n";
    foreach my $node ($xml->findnodes(".//groups/*"))
    {
	my $group = $node->textContent();
	print $fh "   <group>$group</group> \n";
    }
    print $fh "</groups>\n";
    print $fh "\n";

    my @subgroups = qw(none);
    if($file =~ "env_batch.xml"){
	@subgroups = qw(run test st_archive lt_archive);
    }

    my $indent = "  ";
    my $editthis=1;
    my $nodename;
    foreach my $subgroup (@subgroups){
	if($subgroup ne "none"){
	    $indent = "      ";
	    print $fh "  <job name=\"$subgroup\">";
	    $nodename = "job[\@name=\"$subgroup\"]/entry";
	}else{
	    $nodename = "entry";
	}
	# Loop over each file variable, modify if needed, then write it out
	foreach my $node ($xml->findnodes(".//$nodename"))
	{
	    if($subgroup ne "none" && defined $opts{subgroup}){
		$editthis = 0;
		my $pname = $node->parentNode->getAttribute("name");
		if ($pname eq $opts{subgroup}){
		    $editthis=1;
		}
	    }
	    my $name  = $node->getAttribute('id');
	    my $value = $node->getAttribute('value');
	    $value =~ s/'/&apos;/g;
	    $value =~ s/\</&lt;/g;
	    $value =~ s/\</&gt;/g;

	    my ($group, $valid_values, $type, $desc, $is_list_value);
	    foreach my $childnode ($node->childNodes())
	    {
		# Determine all node properties other than value
		if ($childnode->nodeName() eq 'desc') {
		    $desc = $childnode->textContent();
		    $desc =~ s/^\n//;
		    $desc =~ s/\n$//;
		    $desc =~ s/\r//;
		    $desc =~ s/^ *//;
		    chomp $desc;
		}
		if ($childnode->nodeName() eq 'type') {
		    $type = $childnode->textContent();
		}
		if ($childnode->nodeName() eq 'valid_values') {
		    $valid_values = $childnode->textContent();
		}
		if ($childnode->nodeName() eq 'group') {
		    $group = $childnode->textContent();
		}
		if ($childnode->nodeName() eq 'list') {
		    $is_list_value = $childnode->textContent();
		}

	    }

	    # Loop over all entries in the file
	    foreach my $id ( keys(%idlist) )
	    {
		# Make a change to the value if requested
		if ($id eq $name) {
		    my $id_value = $idlist{$id};
		    my $newval   = $id_value;
		    if ($opts{'append'}) {
			# Append new value on the end of old only if old NOT unset
			if ( ($value !~ m/^\s*$/) && ($value !~ m/UNSET/i) ) {
			    $newval = "$value $id_value";
			}
		    }
		    $newval =~ s/'/&apos;/g;
		    $newval =~ s/\</&lt;/g;
		    $newval =~ s/\</&gt;/g;
		    if($editthis==1){
			$value  = $newval;
		    }
		}
	    }
	    $logger->debug("name = $name value = $value subgroup = $subgroup");
	    # Write out the entry
	    write_xml_entry($fh, $name, $value, $type, $valid_values, $desc, $group, $is_list_value, $indent);


	}

	if($subgroup ne "none"){
	    print $fh "  </job>\n";
	}
    }
    # print out the tail of the file
    print $fh "\n";
    print $fh "</config_definition> \n";

    # Before finishing, remove the backup files.
    unlink($backupfile) or $logger->warn ("unable to link $backupfile, $!");
}

if (! $opts{'noecho'}) {
   echo_command_to_CaseStatus();
}

$logger->debug( "xmlchange done.");
exit;

#-----------------------------------------------------------------------------------------------
sub echo_command_to_CaseStatus {
   # Echoes this xmlchange command to the CaseStatus file

    my $cwd = getcwd();                    # current working directory

   if (-f "./CaseStatus") {
      open my $CS, ">>", "$cwd/CaseStatus";
      print $CS "<command>xmlchange @saved_argv</command>\n";
      close $CS;
   }
   else {
      $logger->warn ("WARNING: No CaseStatus file found; this xmlchange command has been executed, but not recorded in the CaseStatus file");
   }
}

#-----------------------------------------------------------------------------------------------
#   TODO this code is duplicated in ConfigCase.pm
#
#

sub write_xml_entry
{
    my ($fh, $id, $value, $type, $valid_values, $desc, $group, $is_list_value, $indent) = @_;

    $value =~ s/'/&apos;/g;
    $value =~ s/\</&lt;/g;
    $value =~ s/\</&gt;/g;

    $desc =~ s/^\n//;
    $desc =~ s/\n$//;
    $desc =~ s/^ *//;
    $desc =~ s/ *$//g;
    chomp $desc;

    print $fh "\n";
    print $fh "$indent<entry id=\"$id\"  value=\"$value\">\n";
    print $fh "$indent  <type>$type</type> \n";
    if ($valid_values  ne '') {print $fh "$indent  <valid_values>$valid_values</valid_values> \n";}
    if ($is_list_value ne '') {print $fh "$indent  <list>$is_list_value</list> \n";}
    print $fh "$indent  <group>$group</group> \n";
    print $fh "$indent  <desc>$desc</desc> \n";
    print $fh "$indent</entry> \n";
}