package ConfigCase;
my $pkg_nm = 'ConfigCase';
#-----------------------------------------------------------------------------------------------
#
# SYNOPSIS
# 
#   use ConfigCase;
# 
#   # read the configuration definition xml file
#   my $cfg = ConfigCase->new("$cfgdir/Tools/config_definition.xml");
#
#   # set some parameters
#   $cfg->set($id, $value);
# 
#   # get some parameters
#   my $value = $cfg->get($id);
#
#   # Write an xml file out
#   $cfg->write_file("$caseroot/env_run.xml", "xml","$caseroot");
#
#   # Write out documentation in a readme file
#   $cfg->write_doc("$caseroot/README/readme_env");
#
#   # Reset the config definition file with all of the values from the xml files
#   # in the $caseroot directory
#   $cfg->reset_setup("$caseroot/env_build.xml");
# 
# DESCRIPTION
# 
# ConfigCase objects are used to represent features of a CCSM model
# configuration that must be specified when a new case is created.
#
# new() Reads xml files that contain the configuration definition and
#       default values of the configuration parameters.
#
#       The "config_definition.xml" file contains all the allowable
#       parameters with a description of each one.  Where appropriate a
#       list of valid values of a parameter is given.  Generic default
#       values that are useful across many model configurations are
#       provided for some parameters.
#
#       The generic default values that are provided in the definition file
#       may be overridden by values in a setup file ("config_setup.xml")
#       that is assumed to provide appropriate values for a specific model
#       configuration.  This setup file is optional.
#
# is_valid_name() Returns true if the specified parameter name is contained in
#       the configuration definition file.
#
# is_ignore_name() Returns true if the specified parameter name is a name to ignore.
#
# is_valid_value() Returns true if the specified parameter name is contained in
#       the configuration definition file, and either 1) the specified value is
#       listed as a valid_value in the definition file, or 2) the definition file
#       doesn't specify the valid values.
#
# is_char() Returns true is the specified parameter name is of character type.
#
# set() Sets values of the configuration parameters.  It takes the
#       parameter name and its value as arguments.  An invalid parameter
#       name (i.e., a name not present in the definition file) triggers an
#       exception.  If the definition file contains valid values of a
#       parameter, then the set method checks for a valid input value.  If
#       and invalid value is found then an exception is thrown.
#       ***NOTE*** If you don't want to trap exceptions, then use the query
#                  functions before calling this routine.
#
# get() Return the value of the specified configuration parameter.  Triggers
#       an exception if the parameter name is not valid.
#       ***NOTE*** If you don't want to trap exceptions, then use the query
#                  functions before calling this routine.
#
# write_file() Write an xml file.  The first argument is the
#       filename.  The second argument, if present, is the commandline of the
#       setup command that was invoked to produce the output configuration
#       file.  It is written to the output file to help document the procedure
#       used to petsetup the executable.
#
# write_doc() Write documentation on the configuration to an output README file.
#
# reset_setup() Reset with all of the values from the xml files in the $caseroot directory
# 
# COLLABORATORS
# 
# IO::File
# XML::Lite
#-----------------------------------------------------------------------------------------------
#
# Date        Author                  Modification
#-----------------------------------------------------------------------------------------------
#  2008-Aug   Mariana Vertensten      Original version
#-----------------------------------------------------------------------------------------------

use strict;
use English;
#use warnings;
#use diagnostics;

use IO::File;
use XML::Lite;
use XML::LibXML;
# Check for the existence of XML::LibXML in whatever perl distribution happens to be in use.
# If not found, print a warning message then exit.
eval {
    require XML::LibXML;
    XML::LibXML->import();
};
if($@)
{
    my $warning = <<END;
WARNING:
  The perl module XML::LibXML is needed for XML parsing in the CESM script system.
  Please contact your local systems administrators or IT staff and have them install it for
  you, or install the module locally.  

END
    print "$warning\n";
	exit(1);
}
use Data::Dumper;

sub new
{
    my $class = shift;
    my ($definition_file, $default_file) = @_;

    # bless the object here so the initialization has access to object methods
    my $cfg = {};
    bless( $cfg, $class );

    # Initialize the object with the configuration definition and its initial setup.
    $cfg->_initialize($definition_file, $default_file);

    return $cfg;
}

#-----------------------------------------------------------------------------------------------

sub is_ignore_name
{
# Return true if the requested name is a name to ignore
# These are descriptive names put in the config files -- but NOT in config_definition.xml

    my ($self, $name) = @_;

    if (    $name eq "NAME" 
	    or $name eq "SHORTNAME" 
            or $name eq "NODENAME_REGEX"
            or $name eq "PROXY"
            or $name eq "TESTS"
	    or $name eq "DESC" 
	    or $name eq "VALID_GRID_MATCH" 
	    or $name eq "GRID_MATCH" 
	    or $name eq "GEN_COMPSET_MATCH"  
	    or $name eq "BEG_COMPSET_MATCH"
	    or $name eq "RES_COMPSET_MATCH"
	    or $name eq "VALID_COMPSET_MATCH"
	    or $name eq "SSTICE_COMPSET_MATCH") {
        return( 1 );
    } else {
        return( 0 );
    }
}

#-----------------------------------------------------------------------------------------------

sub is_valid_name
{
# Return true if the requested name is contained in the configuration definition.

    my ($self, $name) = @_;

    return defined($self->{$name}) ? 1 : 0;
}

#-----------------------------------------------------------------------------------------------

sub is_char
{
# Return true if the requested name is of character type

    my ($self, $name) = @_;

    if ( $self->_get_type($name) eq "char" ) {
        return( 1 );
    } else {
        return( 0 );
    }
}

#-----------------------------------------------------------------------------------------------

sub get
{
# Return requested value.

    my ($self, $name) = @_;

    defined($self->{$name}) or die "ERROR: unknown parameter name: $name\n";

    return $self->{$name}->{'value'};
}

#
# returns the value set in name with all embeded parameters resolved.
#
sub getresolved
{
    my($self,$name) = @_;

    my $val = $self->get($name);
    
    my @vars = grep(/\$([\w_]+)/,$val);
    my $v1 = $val;

    while($v1 =~ /\$([\w_]+)(.*)$/){
	print "v1: $v1\n";
	my $newvar=$1;
	$v1 = $2;
	if($self->is_valid_name($newvar)){
	    my $v2=$self->getresolved($newvar);
	    $val =~ s/\$$newvar/$v2/;
	}
    }
    return $val;
}

#-----------------------------------------------------------------------------------------------

sub is_valid_value
{
# Return true if the specified parameter name is contained in
# the configuration definition file, and either 1) the specified value is
# listed as a valid_value in the definition file, or 2) the definition file
# doesn't specify the valid values.

    my ($self, $id, $value) = @_;

    # Check that the parameter name is in the configuration definition
    unless ($self->is_valid_name($id)) { return 0; }

    # Check that a list value is not supplied when parameter takes a scalar value.
    my $is_list_value = $self->{$id}->{'list'};
    unless ($is_list_value) {  # this conditional is satisfied when the list attribute is false, i.e., for scalars
	if ($value =~ /.*,.*/) { return 0; }   # the pattern matches when $value contains a comma, i.e., is a list
    }

    # Check that the value is valid
    my $valid_values = $self->{$id}->{'valid_values'};
    if ( $valid_values ne "" ) {  # if no valid values are specified, then $value is automatically valid
	if ($is_list_value) {
	    unless (_list_value_ok($value, $valid_values)) { return 0; }
	}
	else {
	    unless (_value_ok($value, $valid_values)) { return 0; }
	}

    }

    return 1;
}

#-----------------------------------------------------------------------------------------------

sub set
{
# Set requested value.
#
# This routine handles errors by throwing exceptions.  It will report exactly what problem was
# found in either the parameter name or requested value.
#
# To avoid dealing with exceptions use the is_valid_name(), is_valid_value() methods to get a
# true/false return before calling the set method.

    my ($self, $id, $value) = @_;

    # Check that the parameter name is in the configuration definition
    $self->is_valid_name($id) or die
	"ERROR: parameter name $id is not in the configuration definition\n";

    # Check that the value is valid
    my $valid_values = $self->{$id}->{'valid_values'};
    #$self->is_valid_value($id, $value) or die
	    #"ERROR: $value is not a valid value for parameter $id: valid values are $valid_values\n";

    # Get the type description hash for the variable and check that the type is valid
    # This method throws an exception when an error is encountered.
    my %type_ref = $self->_get_typedesc($id);
    $self->validate_variable_value($id, $value, \%type_ref);

    # Check that the value is valid
    if ( $valid_values ne "" ) {
       $self->is_valid_value($id, $value) or die
	       "ERROR: $value is not a valid value for parameter $id: valid values are $valid_values\n";
    }

    # Add the new value to the object's internal data structure.
    $self->{$id}->{'value'} = $value;

    return 1;
}

#-----------------------------------------------------------------------------------------------

sub write_file
{
# Write a configuration definition file.

    my $self = shift;
    my $filename = shift;   # filepath for output namelist
    my $format = shift;
    my $caseroot = shift;   # used to read the config_archive.xml file

    # determine what file to write
    my @groups;
    my $xmode;

    $xmode = $self->get("XMLMODE");
    my @comps_atm  = $self->get_valid_values("COMP_ATM"); 
    my @comps_lnd  = $self->get_valid_values("COMP_LND"); 
    my @comps_ocn  = $self->get_valid_values("COMP_OCN"); 
    my @comps_ice  = $self->get_valid_values("COMP_ICE"); 
    my @comps_glc  = $self->get_valid_values("COMP_GLC"); 
    my @comps_rof  = $self->get_valid_values("COMP_ROF"); 
    my @comps_wav  = $self->get_valid_values("COMP_WAV"); 
    my @comps_cpl  = $self->get_valid_values("COMP_CPL"); 
    my @comps      = (@comps_atm, @comps_lnd, @comps_ocn, @comps_ice, @comps_glc, @comps_rof, @comps_wav, @comps_cpl); 

    if ($filename =~ "env_case") {
	@groups = qw(case_def case_desc case_comp case_mach case_der case_last);
    } elsif ($filename =~ "env_mach_pes") {
	@groups = qw(mach_pes_def mach_pes_desc mach_pes_atm mach_pes_lnd 
		     mach_pes_ice mach_pes_ocn mach_pes_cpl mach_pes_glc mach_pes_rof
		     mach_pes_wav mach_pes_stride mach_pes_last);
    } elsif ($filename =~ "env_build") {
	@groups = qw(build_macros build_def build_component build_status 
		     build_grid build_derived);
    } elsif ($filename =~ "env_run") {
       @groups = qw(run_desc run_start run_stop run_rest 
                    run_coupling run_mpi run_pio run_flags
                    run_cplhist run_mach run_din run_dout 
                    run_component run_sstice run_cesm run_domain 
                    run_dirderv run_defpts); 
    } elsif ($filename =~ "env_test") {
       @groups = qw(case_test);
    } elsif ($filename =~ "env_archive") {
       @groups = qw(case_archive);
    } elsif ($filename =~ "env_postprocess") {
       @groups = qw(postprocess);
    } elsif ($filename =~ "env_diags_ocn") {
       @groups = qw(diags_ocn);
    }

    my $fh;
    if ( -f $filename ) { unlink( $filename ); }
    $fh = IO::File->new($filename, '>' ) or die "can't open file: $filename\n";

    if (($format eq "xml") || ($filename =~ m/xml/)) {
    print $fh <<"EOD";
<?xml version="1.0"?>

<config_definition>

EOD
    }

    if ($filename =~ "env_case.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!--       These variables CANNOT BE CHANGED once a case has been created.      -->
<!--       Invoke create_newcase again if a different grid or component         -->
<!--       combination is required.                                             -->
<!--                                                                            -->
<!-- ========================================================================== -->

EOD
}

    if ($filename =~ "env_run.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!--       These variables MAY BE CHANGED ANYTIME during a run.                 -->
<!--       Additional machine speific variables that can be changed             -->
<!--       during a run are contained in the env_mach_specific file             -->
<!--                                                                            -->
<!--       Note1: users SHOULD NOT modify BUILD_COMPETE in env_build.xml        -->
<!--              this is done automatically by the scripts                     -->
<!--                                                                            -->
<!-- ========================================================================== -->

EOD
}
    if ($filename =~ "env_build.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!--       These variables SHOULD NOT be changed once the model has been built. -->
<!--       Currently, these variables are not cached.                           -->
<!--                                                                            -->
<!--       Note1: users SHOULD NOT modify BUILD_COMPETE below                   -->
<!--              this is done automatically by the scripts                     -->
<!--                                                                            -->
<!-- ========================================================================== -->
EOD
}
    if($filename =~ "env_test.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!--       These are the variables specific to a test case.                     -->
<!--                                                                            -->
<!-- ========================================================================== -->
EOD
}
    if ($filename =~ "env_mach_pes.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!--      These variables CANNOT be modified once cesm_setup has been           -->
<!--      invoked without first invoking cesm_setup -clean.                     -->
<!--                                                                            -->
<!-- component task/thread settings                                             -->
<!-- if the user wants to change the values below after ./cesm_setup, run       -->
<!--    ./cesm_setup -clean                                                     -->
<!--    ./cesm_setup                                                            -->
<!--  to reset the pes for the run                                              -->
<!--                                                                            -->
<!--  NTASKS are the total number of MPI tasks                                  -->
<!--  NTHRDS are the number of OpenMP threads per MPI task                      -->  
<!--  ROOTPE is the global mpi task associated with the root task               -->
<!--         of that component                                                  -->     
<!--  PSTRID is the stride of MPI tasks across the global                       -->
<!--         set of pes (for now this is set to 1)                              -->
<!--  NINST is the number of instances of the component (will be spread         -->
<!--        evenly across NTASKS)                                               -->
<!--                                                                            -->
<!--  for example, for a setting with                                           -->  
<!--    NTASKS = 8                                                              -->
<!--    NTHRDS = 2                                                              -->
<!--    ROOTPE = 32                                                             -->
<!--    NINST  = 2                                                              -->
<!--  the MPI tasks would be placed starting on global pe 32                    -->
<!--  and each pe would be threaded 2-ways for this component.                  -->  
<!--  These tasks will be divided amongst both instances (4 tasks each).        -->
<!--                                                                            -->
<!--  Note: PEs that support threading never have an MPI task associated        -->
<!--    with them for performance reasons.  As a result, NTASKS and ROOTPE      -->
<!--    are relatively independent of NTHRDS and they determine                 -->
<!--    the layout of mpi processors between components.  NTHRDS is used        -->
<!--    to determine how those mpi tasks should be placed across the machine.   -->
<!--                                                                            -->
<!--  The following values should not be set by the user since they'll be       --> 
<!--  overwritten by scripts.                                                   -->
<!--    TOTALPES                                                                -->
<!--    CCSM_PCOST                                                              -->
<!--    CCSM_ESTCOST                                                            -->
<!--    PES_LEVEL                                                               -->
<!--    MAX_TASKS_PER_NODE                                                      -->
<!--    PES_PER_NODE                                                            -->
<!--    CCSM_TCOST                                                              -->
<!--    CCSM_ESTCOST                                                            -->
<!--                                                                            -->
<!--  The user can copy env_mach_pes.xml from another run, but they'll need to  -->
<!--  do the following                                                          -->
<!--    ./cesm_setup -clean                                                     -->
<!--    ./cesm_setup                                                            -->
<!--    ./CASE.build                                                            -->
<!--                                                                            -->
<!-- ========================================================================== -->

EOD
}

    if($filename =~ "env_archive.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!--       These are the variables specific to the short and long term          -->
<!--       archivers, and the variable time series file generation.             -->
<!--       We recommend that users *NEVER* run diagnostics                      -->
<!--       or post-processing packages in the same location as the short-term   -->
<!--       (DOUT_S_ROOT.locked) archiver when the model job is running.         -->
<!--       Instead, You may run these packages in the (DOUT_S_ROOT)             -->
<!--       location which contains hard-links back to the files in the          -->
<!--       (DOUT_S_ROOT.locked) directory.                                      -->
<!--       For a detailed listing of the env_archive.xml file, run              -->
<!--       ./st_archive -help                                                   -->
<!--       To validate the env_archive.xml file using xmllint, run              -->
<!--       xmllint -schema ./Tools/config_archive.xsd env_archive.xml           -->
<!--                                                                            -->
<!-- ========================================================================== -->

EOD

}
    if($filename =~ "env_postprocess.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!-- Boolean (True / False) controls for enabling post processing tasks         -->
<!--                                                                            -->
<!-- ========================================================================== -->

EOD
}

    if($filename =~ "env_diags_ocn.xml" && $xmode =~ "normal") {
    print $fh <<"EOD";
<!-- ========================================================================== -->
<!--                                                                            -->
<!-- Controls for generating ocean  diagnostics                                 -->
<!--                                                                            -->
<!-- ========================================================================== -->

EOD
}

    foreach my $group (@groups) {
	if ($group =~ /component/) {
	    foreach my $comp ( @comps ) {
		$comp =~ s/\'//g; # get rid of quotes in $comp
		foreach my $model (qw(COMP_ATM COMP_LND COMP_ICE COMP_OCN COMP_GLC COMP_ROF COMP_WAV)) {
		    if ($self->get($model) eq $comp) {
			my $groupname = $group . "_$comp";
			if (($format eq "xml") || ($filename =~ m/xml/)) {
			    if ($xmode =~ "expert") {
				$self->_write_xml2($fh, $groupname);
			    } else {
				$self->_write_xml($fh, $groupname);
				if ($group =~ 'build_component') {
				    # do nothing
				} else {
				    print $fh "\n<!-- ====================================== -->";
				}
			    }
			} else {
			    die " only xml mode supported";
			}
		    }
		}
	    }
	} else {
	    if (($format eq "xml") || ($filename =~ m/xml/)) {
		if ($group =~ m/mach_pes_/ || $xmode =~ "expert") {
		    $self->_write_xml2($fh, $group);
		} else {
		    $self->_write_xml($fh, $group, $caseroot);
		    if ($group =~ 'build_component') {
			# do nothing
		    } else {
			print $fh "\n<!-- ====================================== -->";
		    }
		}
	    } else {
		die " only xml mode supported";
	    }
	}
    }
    if (($format eq "xml") || ($filename =~ m/xml/)) {
    print $fh <<"EOD";

</config_definition>
EOD
    }
}

#-----------------------------------------------------------------------------------------------

sub write_doc
{
# Write the documentation on the configuration to an output README file.

    my $self = shift;
    my $filename = shift;   # filepath for output namelist

    my $fh;
    if ( -f $filename ) { unlink( $filename ); }
    $fh = IO::File->new($filename, '>' ) or die "can't open file: $filename\n";

    my @ids = keys %$self;
    foreach my $id (sort @ids) {

	print $fh "name: $id \n";
        my $ldesc = $self->{$id}->{'ldesc'};
        if ( ! defined($ldesc) ) { $ldesc = ""; }
	print $fh "description: " . $ldesc . "\n"; 
	if ($self->{$id}->{'valid_values'}) {
	    print $fh "valid values: $self->{$id}->{'valid_values'} \n"; 
	}
	print $fh "default value: $self->{$id}->{'value'} \n"; 
	if ( $self->{$id}->{'group'} =~ "case" ) {
	    print $fh "file: env_case.xml \n";
	    print $fh "locked_stage: create_newcase \n"; 
	}
	if ( $self->{$id}->{'group'} =~ "confrun" ) {
	    print $fh "file: env_run.xml \n";
	    print $fh "locked_stage: mach_pes none \n"; 
	}
	if ( $self->{$id}->{'group'} =~ "run" ) {
	    print $fh "file: env_run.xml \n";
	    print $fh "locked_stage: none \n"; 
	}
	if ( $self->{$id}->{'group'} =~ "build" ) {
	    print $fh "file: env_build.xml \n";
	    print $fh "locked_stage: build \n"; 
	}
	print $fh " \n";
    }
}

#-----------------------------------------------------------------------------------------------

sub write_docbook_master
{
# Write the documentation on the configuration to an output README file.

    my $self = shift;
    my $filename = shift;   # filepath for output namelist

    my $fh;
    if ( -f $filename ) { unlink( $filename ); }
    $fh = IO::File->new($filename, '>' ) or die "can't open file: $filename\n";

    my $gid;

    if ($filename =~ "case") { 
        $gid = "case";
	print $fh "<table><title>env_case.xml variables</title>\n";
    } elsif($filename =~ "build") {
        $gid = "build";
	print $fh "<table><title>env_build.xml variables</title>\n";
    } elsif($filename =~ "mach_pes") {
        $gid = "mach_pes";
	print $fh "<table><title>env_mach_pes.xml variables</title>\n";
    } elsif($filename =~ "run") {
        $gid = "run";
	print $fh "<table><title>env_run.xml variables</title>\n";
    }
	print $fh "<tgroup cols=\"4\">\n";
	print $fh "<thead>\n";
	print $fh "<row> \n";
	print $fh "<entry>Name</entry>\n";
	print $fh "<entry>Type</entry>\n";
	print $fh "<entry>Default</entry>\n";
	print $fh "<entry>Description [Valid Values]</entry>\n";
	print $fh "</row> \n";
	print $fh "</thead>\n";
	print $fh "<tbody>\n";
    
    my @ids = keys %$self;
    foreach my $id (sort @ids) {

        my $ldesc = "";
        my $valid = "";
        my $value = "";
        my $type  = "";

        $ldesc = $self->{$id}->{'ldesc'};
  	$valid = $self->{$id}->{'valid_values'};
	$value = $self->{$id}->{'value'};
	$type  = $self->{$id}->{'type'};

        if ( ! defined($ldesc) ) { $ldesc = ""; }
        if ( ! defined($valid) ) { $valid = ""; }
        if ( ! defined($value) ) { $value = ""; }
        if ( ! defined($type) ) { $type = ""; }

	    if ( $self->{$id}->{'group'} =~ $gid ) {
		print $fh "<row> \n";
		print $fh "<entry>$id</entry>\n";
		print $fh "<entry>$type</entry>\n";
		print $fh "<entry>$value</entry>\n";
		if ($self->{$id}->{'valid_values'}) {
		    print $fh "<entry>$ldesc [$valid] </entry>\n";
		} else {
		    print $fh "<entry>$ldesc</entry>\n";
                }
		print $fh "</row>\n";
	    }	    
    }
    print $fh "</tbody>\n";
    print $fh "</tgroup>\n";
    print $fh "</table>\n";
}

#-----------------------------------------------------------------------------------------------

sub reset_setup
{

# Reset the config object from the setup file

    my ($self, $setup_file, $setup_id) = @_;

    # Process the setup file
    my $xml = XML::Lite->new( $setup_file );
    my $root = $xml->root_element();

    # Each parameter is contained in an "entry" element.  Get all these elements.
    my @elements = ();
    @elements = $xml->elements_by_name('entry');
    
    # Loop over the elements...
    foreach my $e (@elements) {
	
	# and extract the attributes
	my %attributes = $e->get_attributes();
	
	# just get the parameter name and value
	my $id    = $attributes{'id'};
	my $value = $attributes{'value'};
	
	# set new value
	if (defined($setup_id)) {
	    if ($id ne $setup_id) {$self->set($id, $value);}
	} else {
	    $self->set($id, $value);
	}
    } # end processing setup file
}

#-----------------------------------------------------------------------------------------------
# Private methods
#-----------------------------------------------------------------------------------------------

sub _initialize
{
# Read the configuration definition file.  Create an anonymous hash with the following
# structure:
# { id1 => {type=>'ttt', value=>"xxx", list =>"XXX", valid_values=>"yyy", 
#           group=>'vvv', sdesc=>'www', ldesc=>'WWW',definition=>"zzz"},
#   id2 => {type=>'ttt', value=>"xxx", list =>"XXX", valid_values=>"yyy", 
#           group=>'vvv', sdesc=>'www', ldesc=>'WWW',definition=>"zzz"},
#   ...												     										
#   idn => {type=>'ttt', value=>"xxx", list =>"XXX", valid_values=>"yyy", 
#           group=>'vvv', sdesc=>'www', ldesc=>'WWW',definition=>"zzz"},
# }

    my ($self, $definition_file, $setup_file) = @_;

    # Process the definition file
    my $xml = XML::Lite->new( $definition_file );
    my $root = $xml->root_element();

    # Check for valid root node
    my $name = $root->get_name();
    $name eq "config_definition" or die
	"ERROR: $definition_file is not a configuration definition file\n";

    # Each parameter is contained in an "entry" element.  Get all these elements.
    my @elements = $xml->elements_by_name('entry');

    # Loop over the elements...
    my $index = 0;
    foreach my $e (@elements) {

        # and extract the attributes and element content.
	my %attributes = $e->get_attributes();
	my $content    = $e->get_content();
	# if present strip initial and final newlines from content
	$content =~ s/^\n{1}//;
	$content =~ s/\n{1}$//;

	# Look for the specific attributes that are contained in the configuration definition.
	my $id    = $attributes{'id'};
	my $value = $attributes{'value'};
        my $sdesc = $attributes{'sdesc'};
        my $ldesc = $attributes{'ldesc'};
        my $list  = $attributes{'list'};
	my $group = $attributes{'group'};
	my $type  = $attributes{'type'};
	my $valid_values = defined $attributes{'valid_values'} ? $attributes{'valid_values'} : "";

	my $i = $index++; 
	# Now add the attributes and content to the object's internal data structure.
	$self->{$id} = {'type'         => $type, 
			'value'        => $value, 
			'list'         => $list, 
			'valid_values' => $valid_values, 
			'sdesc'        => $sdesc, 
			'ldesc'        => $ldesc, 
                        'definition'   => $content, 
			'group'        => $group,
                        'index'        => $i};
    }

    # Process the setup file
    if (defined $setup_file) {
	my $xml = XML::Lite->new( $setup_file );
	my $root = $xml->root_element();

	# Check for valid root node
	my $name = $root->get_name();
	$name eq "config_definition" or die
	    "ERROR: $definition_file is not a configuration definition file\n";

	# Each parameter is contained in an "entry" element.  Get all these elements.
	@elements = ();
	@elements = $xml->elements_by_name('entry');

	# Loop over the elements...
	foreach my $e (@elements) {

	    # and extract the attributes
	    my %attributes = $e->get_attributes();

	    # just get the parameter name and value
	    my $id    = $attributes{'id'};
	    my $value = $attributes{'value'};

	    # set new value
	    $self->set($id, $value);
	}
    } # end processing setup file
}

#-----------------------------------------------------------------------------------------------

sub _write_xml
{
# Write a single XML element out to a file

    my $self = shift;
    my $fh = shift;   # filepath for output namelist
    my $group = shift;
    my $caseroot = shift; # used to read config_archive

    # separate the groups with spaces
    print $fh <<"EOD";

EOD

    # first determine all of the indices you will write out
    my %id_indices;  
    my @ids = keys %$self;
    foreach my $id (sort @ids) {
	if ($group eq $self->{$id}->{'group'}) {
	    my $i = $self->{$id}->{'index'};
            $id_indices{$i} = $id;
	}
    }

    # check if the group is set to case_archive 
    if( $group eq 'case_archive') {
	my $archive_file = qq($caseroot/config_archive.xml);
	open CONFIG_ARCHIVE, $archive_file or die $!;
	while (<CONFIG_ARCHIVE>) {
	    chomp;
	    print $fh "$_\n";
	}
	close (CONFIG_ARCHIVE);
    }

    # add the entry elements
    my @notsorted = keys %id_indices;
    my @sorted = sort { $a <=> $b } @notsorted;
    foreach my $i (@sorted) {
	my $id = $id_indices{$i};
	if ($self->{$id}->{'valid_values'} ne '') {
	    print $fh <<"EOD";

<!--"$self->{$id}->{'sdesc'}, valid values: $self->{$id}->{'valid_values'} ($self->{$id}->{'type'}) " -->
<entry id="$id"   value="$self->{$id}->{'value'}"  />    
EOD
} else {
		print $fh <<"EOD";

<!--"$self->{$id}->{'sdesc'} ($self->{$id}->{'type'}) " -->
<entry id="$id"   value="$self->{$id}->{'value'}"  />    
EOD
}

    }
}


#-----------------------------------------------------------------------------------------------

sub _write_xml2
{
# Write a single XML element out to a file

    my $self = shift;
    my $fh = shift;   # filepath for output namelist
    my $group = shift;

    # separate the groups with spaces
    print $fh <<"EOD";

EOD

    # first determine all of the indices you will write out
    my %id_indices;  
    my @ids = keys %$self;
    foreach my $id (sort @ids) {
	if ($group eq $self->{$id}->{'group'}) {
	    my $i = $self->{$id}->{'index'};
            $id_indices{$i} = $id;
	}
    }

    # add the entry elements
    my @notsorted = keys %id_indices;
    my @sorted = sort { $a <=> $b } @notsorted;
    foreach my $i (@sorted) {
	my $id = $id_indices{$i};
	print $fh <<"EOD";
<entry id="$id"   value="$self->{$id}->{'value'}"  />    
EOD
    }
}


#-----------------------------------------------------------------------------------------------

sub _list_value_ok
{
# Check that all input values ($values_in may be a comma separated list)
# are contained in the comma separated list of valid values ($valid_values).
# Return 1 (true) if all input values are valid, Otherwise return 0 (false).

    my ($values_in, $valid_values) = @_;

    my @values = split /,/, $values_in;

    my $num_vals = scalar(@values);
    my $values_ok = 0;

    foreach my $value (@values) {

	if (_value_ok($value, $valid_values)) { ++$values_ok; }

    }

    ($num_vals == $values_ok) ? return 1 : return 0;
}

#-----------------------------------------------------------------------------------------------

sub _value_ok
{

# Check that the input value is contained in the comma separated list of
# valid values ($valid_values).  Return 1 (true) if input value is valid,
# Otherwise return 0 (false).

    my ($value, $valid_values) = @_;

    # If the valid value list is null, all values are valid.
    unless ($valid_values) { return 1; }

    my @expect = split /,/, $valid_values;

    $value =~ s/^\s+//;
    $value =~ s/\s+$//;
    foreach my $expect (@expect) {
	if ($value =~ /^$expect$/) { return 1; }
    }

    return 0;
}

#-----------------------------------------------------------------------------------------------

sub get_var_type
{
# Return 'type' attribute for requested variable

    my ($self, $name) = @_;

    return $self->{$name}->{'type'};
}

#-----------------------------------------------------------------------------------------------

sub get_valid_values
{
# Return list of valid_values as an array for requested variable
# To return without quotes use the 'noquotes'=>1 option.
    my ($self, $name, %opts) = @_;

    my $valid_values = $self->{$name}->{'valid_values'};
    my $type = $self->{$name}->{'type'};
    my @values = split( /,/, $valid_values );

    # if string type and NOT noquote option and have a list -- add quotes around values
    if ( ! defined($opts{'noquotes'}) || ! $opts{'noquotes'} ) {
       if ( $#values > -1 && ($type eq "char") ) {
          for( my $i=0; $i <= $#values; $i++ ) {
             $values[$i] = "'$values[$i]'";
          }
       }
    }
    return( @values );
}

#-----------------------------------------------------------------------------------------------

sub _get_type
{
# Return 'type' attribute for requested variable

    my ($self, $name) = @_;

    return $self->{$name}->{'type'};
}

#-----------------------------------------------------------------------------------------------

sub get_str_len
{
# Return 'str_len' attribute for requested variable

    my ($self, $name) = @_;
    my $lc_name = lc $name;

    return $self->{$lc_name}->{'str_len'};
}


#-----------------------------------------------------------------------------------------------

sub _get_typedesc
#
# Return hash of description of data type read in from the file:
# Hash keys are:
#      type           type description (char, logical, integer, or real) (string)
#      strlen         Length of string (if type char)                          (integer)
#      validValues    Reference to array of valid values                 (string)
#
{
    my ($self, $name) = @_;
    my $nm = "_get_typedesc";

    my %datatype;
    my $type_def = $self->_get_type($name);
    my $lc_name = lc $name;
    if ($type_def =~ /^(char|logical|integer|real)/ ) {
      $datatype{'type'} = $1;
    } else {
	die "ERROR: in $nm (package $pkg_nm): datatype $type_def is NOT valid\n";
    }
    if ( $datatype{'type'} eq "char" ) {
       if ($type_def =~ /^char\*([0-9]+)/ ) {
           $datatype{'strlen'} = $1;
       } else {
           $datatype{'strlen'} = 9999999;
       }
    } else {
       $datatype{'strlen'} = undef;
    }
    my @valid_values = $self->get_valid_values( $name );
    $datatype{'validValues'}  = \@valid_values;
    return( %datatype );
}

#-----------------------------------------------------------------------------------------------
# Perl regular expressions to match Fortran namelist tokens.

# Variable names.
# % for derived types, () for arrays
my $varmatch = "[A-Za-z_]{1,31}[A-Za-z0-9_]{0,30}[(0-9)%a-zA-Z_]*";

# Integer data.
my $valint = "[+-]?[0-9]+";
my $valint_repeat = "${valint}\\*$valint";

# Logical data.
my $vallogical1 = "[Tt][Rr][Uu][Ee]";
my $vallogical2 = "[Ff][Aa][Ll][Ss][Ee]";
my $vallogical = "$vallogical1|$vallogical2";
my $vallogical_repeat = "${valint}\\*$vallogical1|${valint}\\*$vallogical2";

# Real data.
# "_" are for f90 precision specification
my $valreal1 = "[+-]?[0-9]*\\.[0-9]+[EedDqQ]?[0-9+-]*";
my $valreal2 = "[+-]?[0-9]+\\.?[EedDqQ]?[0-9+-]*";
my $valreal = "$valreal1|$valreal2";
my $valreal_repeat = "${valint}\\*$valreal1|${valint}\\*$valreal2";

# Match for all valid data-types: integer, real or logical
# note: valreal MUST come before valint in this string to prevent integer portion of real 
#       being separated from decimal portion
my $valall = "$vallogical|$valreal|$valint";

# Match for all valid data-types with repeater: integer, real, logical, or string data
# note: valrepeat MUST come before valall in this string to prevent integer repeat specifier 
#       being accepted alone as a value
my $valrepeat = "$vallogical_repeat|$valreal_repeat|$valint_repeat";

# Match for all valid data-types with or without numberic repeater at the lead
my $valmatch = "$valrepeat|$valall";

# Same as above when a match isn't required
my $nrvalmatch = $valmatch. "||";

#-----------------------------------------------------------------------------------------------

sub validate_variable_value
#
# Validate that a given value matches the expected input type definition
# Expected description of keys for the input type hash is:
#      type           type description (char, logical, integer, or real)       (string)
#      strlen         Length of string (if type char)                          (integer)
#      validValues    Reference to array of valid values                       (string)
#
{
  my ($self, $var, $value, $type_ref) = @_;
  my $nm = "validate_variable_value";

  # Ensure type hash has required variables
  if ( ref($type_ref) !~ /HASH/ ) {
      die "ERROR: in $nm : Input type is not a HASH reference.\n";
  }
  foreach my $item ( "type", "validValues", "strlen" ) {
     if ( ! exists($$type_ref{$item}) ) {
         die "ERROR: in $nm: Variable name $item not defined in input type hash.\n";
     }
  }

  # If string check that less than defined string length
  my $str_len = 0;
  if ( $$type_ref{'type'} eq "char" ) {
      $str_len = $$type_ref{'strlen'};
      if ( length($value) > $str_len ) {
         die "ERROR: in $nm Variable name $var " .
             "has a string element that is too long: $value\n";
      }
  }
  # If not string -- check that array size is smaller than definition
  my @values;
  if ( $str_len == 0 ) {
      @values = split( /,/, $value );
      # Now check that values are correct for the given type
      foreach my $i ( @values ) {
	  my $compare;
	  if (      $$type_ref{'type'} eq "logical" ) {
	      $compare = $vallogical;
	  } elsif ( $$type_ref{'type'} eq "integer" ) {
	      $compare = $valint;
	  } elsif ( $$type_ref{'type'} eq "real" ) {
	      $compare = $valreal;
	  } else {
	      die "ERROR: in $nm (package $pkg_nm): Type of variable name $var is " . 
		  "not a valid FORTRAN type (logical, integer, real, or char).\n";
	  }
	  if ( $i !~ /^\s*(${compare})$/ ) {
	      die "ERROR: in $nm (package $pkg_nm): Variable name $var " .
		  "has a value ($i) that is not a valid type " . $$type_ref{'type'} . "\n";
	  }
      }
  }
}

sub get_machine_xml
{
    # open the specified xml file, verify that it is a "machines" file
    # and try to extract the desired machine.
    my ($self, $machine_file, $machine, $print) = @_;

    if (! -f "$machine_file")  {
      my $found = 0;
      my @mach_settings;
      return $found, @mach_settings;
    }

    my $xml = XML::Lite->new( $machine_file );
    my $root = $xml->root_element();

    # Check for valid root node
    my $name = $root->get_name();
    $name eq "config_machines" or die
	"file $machine_file is not a machine parameters file\n";

    # Read the machine parameters from $machine_file.
    my @e = $xml->elements_by_name( "machine" );
    my %a = ();

    my $mach=$machine;
    if($machine =~ /(.*)_/){
       $mach=$1;
    }
    # Search for matching machine.
    my $found = 0;
    my @mach_settings;
  MACHINE:
    while ( my $e = shift @e ) {
	%a = $e->get_attributes();
	if ( ($machine eq $a{'MACH'}) or ($mach eq $a{MACH})) {
	    $found = 1;
	    @mach_settings = $e->get_children();
	    last MACHINE;
	}
    }
    return $found, @mach_settings;
}

sub set_machine
{
    # Set the parameters for the specified machine.  Try looking for
    # the machine in the users ~/.cesm directory. If it is not found
    # then check the standard machines location. The parameters are
    # read from an input file, and if no machine matches are found
    # then issue error message.  This routine uses the configuration
    # defined at the package level ($cfg_ref).

    my ($self, $machine_file, $machine, $print) = @_;

    my ($found, @mach_settings) = $self->get_machine_xml("$ENV{'HOME'}/.cesm/config_machines.xml",
                                                         $machine, $print);
    if ($found) {
      print "\nFound UNSUPPORTED machine \"$machine\" in file : $ENV{'HOME'}/.cesm/config_machines.xml\n";
    }  else {
      ($found, @mach_settings) = $self->get_machine_xml($machine_file, $machine, $print);
    }

    # Die unless search was successful.
    unless ($found) { 
	print "set_machine: no match for machine $machine :\n";
        print "  - possible SUPPORTED machine values are \n";
	print_machines( $machine_file );
        if ( -f "$ENV{'HOME'}/.cesm/config_machines.xml") {
          print "\n  - possible UNSUPPORTED machine values are \n";
          print_machines( "$ENV{'HOME'}/.cesm/config_machines.xml" );
        }
	die "set_machine: exiting\n"; 
    }

    # Loop through all entry_ids of the $self object and if the corresponding 
    # attributed is defined in the compset hash, then reset the self object to
    # that value


    my $setting;
    foreach $setting (@mach_settings){
	my $sname = $setting->get_name();
	next if($self->is_ignore_name($sname)) ;
	if ( ! $self->is_valid_name($sname) ) { 
	    die "set_machine: invalid id $sname in machine $machine in file $machine_file exiting\n"; 
	}
        # allow for environment variables in the config_machines.xml file 
        # using $ENV{variablename} syntax
	my $text = $setting->get_text();
	if($text =~/^(.*)\$ENV{(.*)}(.*)$/){
	    $text = $1.$ENV{$2}.$3;
	}
	$self->set($sname,$text);
	

	print "cfg_ref: $sname set to ".$self->get($sname)."  $text\n" if($print==2);
    }
    $self->set('MACH',$machine);



}

#-------------------------------------------------------------------------------
sub print_machines
{
    # Print all currently supported machines
    my ($machine_file) = @_;
    my $xml = XML::Lite->new( $machine_file );
    my $root = $xml->root_element();

    # Check for valid root node
    my $name = $root->get_name();
    $name eq "config_machines" or die
	"file $machine_file is not a machine parameters file $name\n";

    print ("  \n");
    print ("  MACHINES:  name (description)\n");
    
    # Read the grid parameters from $grid_file.
    my @e = $xml->elements_by_name( "machine" );
    my %a = ();
    while ( my $e = shift @e ) {
	%a = $e->get_attributes();
	my @children = $e->get_children();
	my $child;
	foreach $child (@children){
	    if($child->get_name == "DESC"){
		my $desc = $child->get_text();
		print "    $a{'MACH'} ($desc) \n";		
		last;
	    }
	}
    }
}

#-----------------------------------------------------------------------------------------------
sub set_pes
{
    # Set the parameters for the pe layout.    
    my($self,$pes_file,$decomp_ref,$pecount_opts, $print, $testwithopts) = @_;

    #print "tcx1: pecount_opts: $pecount_opts\n";

    # Initialize some local variables
    my $nm = "set_pes"; 
    my @matches = keys(%$self);
	#print "matches: \n";
	#map { print "$_\n"} sort @matches;
    if ( ref($decomp_ref) ne "HASH" ) { die "ERROR::($nm) input decomp is not a hash!\n"; }

    # Open and read the xml file
    my $xml = XML::Lite->new( $pes_file );
    if ( ! defined($xml) ) {
	die "ERROR($nm): Trouble opening or reading $pes_file\n";
    }
    my $elm  = $xml->root_element( );
    my $root = "pesinfo";
#    my $root = "config_definition";

    my @children = $xml->elements_by_name( $root );
    if ( $#children < 0 ) {
	die "ERROR($nm): could not find the main $root root element in $pes_file\n";
    }
    if ( $#children != 0 ) {
	die "ERROR($nm): $root root element in $pes_file is duplicated, there should only be one\n";
    }
    
    # examine the attributes of each element to determine the "best fit"
    my $possible_match ;
    my $pecount_vals = " ";
    for (my $i = 0; $i <= $#children; $i++) {
	#
	# Name of element, and it's associated attributes
	my $child = $children[$i];
	my $name = $child->get_name();
	my @children_level = $child->get_children();
	my $num_children = $#children_level+1;
	if ( $#children_level > -1 ) {
	    foreach my $child_level ( @children_level ) {
		
		# Check all the attributes for this element to determine if we have a complete match
		my %atts = $child_level->get_attributes;
		my @keys = keys(%atts);
		my $num_matches = 0;
		foreach my $key ( @keys ) {
		    foreach my $var ( @matches ) {
			my $match = $atts{$key};
                        # Match either the begining or the end of the line
			if ( ($key eq $var)){ 
			   if($var eq "GRID"  && (($self->get($var) =~ /$match/ ))){
			       $num_matches++; 
			   }elsif ($var eq "CCSM_LCOMPSET" &&
				   $self->get($var) =~ /$match/ ) {
			       # For CCSM_LCOMPSET, we consider it a match if it matches any part of
			       # the compset name (similar to GEN_COMPSET_MATCH in config_compsets.xml)
			       $num_matches++;
			   }elsif ($self->get($var) =~ /^$match/ ) {
			       $num_matches++; 
			   }
			   
			}
		    }

		    if ($key eq "PECOUNT") {
			if($pecount_opts =~ /^$atts{$key}$/){
			    $num_matches++;
			}
		    }
			# If the TEST attribute exists, then we are either using this layout for
			# a particular test, or NOT using this layout for a particular test via
			# the use of a regular expression..
			if($key eq "TEST") {
				if(defined $testwithopts && $testwithopts =~ /$atts{$key}/) {
				  print "Test with opts $testwithopts matches $atts{$key}\n";
				  $num_matches++;
	            }
			}

		}
		




		# Need all the attributes to match in order to read the element pes
		my $num_keys = $#keys + 1;

		if ($num_matches eq $num_keys) {

		    my %atts = $child_level->get_attributes;
		    my @keys = keys(%atts);


		    foreach my $key ( @keys ) {
			$possible_match->{$key} = $atts{$key};
		    }

		    my @decomp_children = $child_level->get_children();
		    if ( $#decomp_children > -1 ) {
			foreach my $decomp_child ( @decomp_children ) {
			    my $name  = $decomp_child->get_name();
			    my $value = $decomp_child->get_text();
                            # Use exists over defined, as MPILIB exists but set to undef by default
			    if ( ! exists($$decomp_ref{$name}) ) {
				die "ERROR($nm): $name is NOT a valid element for the decomp output hash\n";
			    }
			    $$decomp_ref{$name} = $value;
			}
		    } else {
			die "ERROR($nm): No sub-elements for $name \n";
		    }
		}  
	    }
	}
    }


    print "The PE layout for this case match these options:\n";
    foreach my $key (keys %$possible_match){
      print "$key =  $possible_match->{$key}\n";
  }
}

# Parse all the xml files, and resolve every variable. 
sub getAllResolved
{
	my $self = shift;
	# hash for all the parsers, and a hash for 
	# all the config variables. 
	my %parsers;
	my %masterconfig;
	
	# Get all the env*.xml files into an array...
	my @xmlfiles = qw( env_build.xml env_case.xml env_mach_pes.xml env_run.xml);
	push(@xmlfiles, "env_test.xml") if(-e "./env_test.xml");
	push(@xmlfiles, "env_archive.xml") if(-e "./env_archive.xml");
	
	# Set up a new XML::LibXML parser for each xml file. 
	foreach my $basefile(@xmlfiles)
	{
		my $xmlparser = XML::LibXML->new();
		my $parser = $xmlparser->parse_file($basefile);
		$parsers{$basefile} = $parser;
	}
	
	# find all the entry nodes. 
	foreach my $basefile(@xmlfiles)
	{
		my $parser = $parsers{$basefile};	
		my @nodes = $parser->findnodes("//entry");
		foreach my $node(@nodes)
		{
			my $id = $node->getAttribute('id');
			my $value = $node->getAttribute('value');
			# if the entry value has an unresolved variable, 
			# we need to find it in whatever file it might be in. 
			$value = _resolveValues($value, \%parsers);
			$masterconfig{$id} = $value;
		}
	}
	return %masterconfig;
}

# Recursively resolve the unresolved vars in an entry value.  
# Check the value passed in, and if it still has an unresolved var, keep calling the function
# until all pieces of the variable are resolved.  
sub _resolveValues
{
	my $value = shift;
	my $parsers = shift;
	#print "in _resolveValues: value: $value\n";
	# We want to resolve $values from either tthe other xml files, or 
	# the value can come from the 
	if($value =~ /(\$[\w_]+)/)
	{
		#print "in _resolveValues: value: $value\n";
		my $unresolved = $1;
		
		#print "need to resolve: $unresolved\n";
		my $needed = $unresolved;
		$needed =~ s/\$//g;
	
		my $found = 0;
		foreach my $parser(values %$parsers)
		{
			my @resolveplease = $parser->findnodes("//entry[\@id=\'$needed\']");
			if(@resolveplease)
			{
				$found = 1;
				foreach my $r(@resolveplease)
				{
					my $rid = $r->getAttribute('id');
					my $rvalue = $r->getAttribute('value');
					$value =~ s/\$$needed/$rvalue/g;
					#print "value after substitution: $value\n";
				}
			}
		}
		# Check the environment if not found in the xml files. 
		if(!$found)
		{
			if(exists $ENV{$needed})
			{
				$found = 1;
				my $rvalue = $ENV{$needed};
				$value =~ s/\$$needed/$rvalue/g;
			}
		}
		#if the value is not found in any of the xml files or in the environment, then
		# return undefined. 
		if(!$found)
		{
			return undef;
		}
		_resolveValues($value, $parsers);
	}
	else
	{
		#print "returning $value\n";
		return $value;
	}
}


1; # to make use or require happy