#!/usr/bin/env perl #----------------------------------------------------------------------------------------------- # # xmlquery # # This utility allows the CESM user to view a field in a env_*xml file via a commandline interface. # #----------------------------------------------------------------------------------------------- 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 XML::LibXML; #----------------------------------------------------------------------------------------------- sub usage { die <). 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. -fileonly Only print the filename that the field is in. -valonly Only print the value of the field. -value Only print the value of the field without any equal or identifier. -noexpandxml Do not expand any xml variables that the value is dependent on. -help [or -h] Print usage to STDOUT. -verbose [or -v] Turn on verbose echoing of what xmlquery is doing. EOF } #----------------------------------------------------------------------------------------------- if ($#ARGV == -1) { print "ERROR: no arguments sent in -- id name is REQUIRED\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(); #----------------------------------------------------------------------------------------------- # Set the directory that contains the CESM configuration scripts. If the create_newcase command was # issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the # command was issued from the current working directory. (my $ProgName = $0) =~ s!(.*)/!!; # name of this script my $ProgDir = $1; # name of directory containing this script -- may be a # relative or absolute path, or null if the script is in # the user's PATH my $cwd = getcwd(); # current working directory my $cfgdir; # absolute pathname of directory that contains this script if ($ProgDir) { $cfgdir = abs_path($ProgDir); } else { $cfgdir = $cwd; } #----------------------------------------------------------------------------------------------- # Parse command-line options. my %opts = ( fileonly =>0, valonly =>0, value =>0, noexpandxml =>0, help =>0, listall =>0, verbose =>0, ); GetOptions( "fileonly" => \$opts{'fileonly'}, "valonly" => \$opts{'valonly'}, "value" => \$opts{'value'}, "noexpandxml" => \$opts{'noexpandxml'}, "h|help" => \$opts{'help'}, "v|verbose" => \$opts{'verbose'}, ) or usage(); # Give usage message. usage() if $opts{'help'}; # Get id from anything left over my $idlist = shift( @ARGV ); my @ids; if ( $idlist eq "list" ) { $opts{'listall'} = 1; } else { @ids = split( /,/, $idlist ); } # Check for unparsed arguments if (@ARGV) { print "ERROR: unrecognized arguments: @ARGV\n"; print "A list of ID's needs to be comma-delimited with NO-WHITESPACE!\n"; usage(); } # if ($opts{'value'} && $opts{'fileonly'} ) { die "value and fileonly modes can NOT both be set\n"; } if ($opts{'valonly'} && $opts{'fileonly'} ) { die "valonly and fileonly modes can NOT both be set\n"; } # Define 3 print levels: # 0 - only issue fatal error messages # 1 - only informs what files are created (default) # 2 - verbose my $print = 1; if ($opts{'verbose'}) { $print = 2; } my $eol = "\n"; my %cfg = (); # build configuration #----------------------------------------------------------------------------------------------- # Make sure we can find required perl modules and configuration files. # Look for them in the directory that contains the configure script. # Check for the main configuration definition file. my $config_def_file = "config_definition.xml"; my $dir = "$cfgdir/Tools"; my $cdir = abs_path( "$cfgdir" ); if ( -f "$dir/$config_def_file" ) { $config_def_file = "$dir/$config_def_file"; } elsif ( -f "$cfgdir/$config_def_file" ) { $dir = $cdir; $config_def_file = "$cdir/$config_def_file"; } else { die <<"EOF"; ** Cannot find configuration definition file \"$config_def_file\" in directory Tools ** EOF } my $parser = XML::LibXML->new( no_blanks => 1); # search config_definition file to determine if id is a valid name # and exit early if id is NOT a valid name my $xml = $parser->parse_file($config_def_file); my @nodes = $xml->findnodes("//entry"); if ( ! $opts{'listall'} ) { foreach my $id ( @ids ) { chomp($id); my $match; foreach my $node (@nodes) { my $id_attr = $node->getAttribute('id'); chomp($id_attr); if ($id eq $id_attr) { $match = 1; last; } } if (! defined $match) { die "ERROR: id $id NOT a valid name in the config_definition file\n"; } } } #----------------------------------------------------------------------------------------------- my @dirs = ( "$cfgdir", "$cfgdir/Tools" ); unshift @INC, @dirs; require SetupTools; #----------------------------------------------------------------------------------------------- # Loop over all of the files and fill the hashes my @filenames = glob( "env_*.xml" ); my %myfile; my %xmlvars; FILELOOP: foreach my $file ( @filenames ) { # Verify that file is NOT empty if ( ! -r $file ) { die "ERROR: file $file does NOT exist\n"; } # Add the list of ALL *xml fields to a hash my $xml = $parser->parse_file($file); my @nodes = $xml->findnodes("//entry"); foreach my $node (@nodes) { my $id_attr = $node->getAttribute('id'); my $val_attr = $node->getAttribute('value'); $xmlvars{$id_attr} = $val_attr; # check if any of the id's input are in this file if ( ! $opts{'listall'} ) { foreach my $id ( @ids ) { if ($id eq $id_attr) { $myfile{$id} = $file; } } } else { # if listall option is set, add this id to id array, and add file to myfile hash push( @ids, $id_attr ); $myfile{$id_attr} = $file; } } } # Report the results foreach my $id ( @ids ) { unless (defined($myfile{$id}) ) { if ( $opts{'value'} ) { exit(1); } else { die "WARNING: id $id not found in any of the files: @filenames \n"; } } if ( ! $opts{'value'} ) { if ( ! $opts{'valonly'} ) { print "$myfile{$id}"; print ": "; } print "$id" if $print > 0; if ( ! $opts{'fileonly'} ) { print " = " if $print > 0; my $value = $xmlvars{$id}; if ( ! $opts{'noexpandxml'} ) { $value = SetupTools::expand_xml_var( $value, \%xmlvars ); } print "$value"; } print "\n"; } else { my $value = $xmlvars{$id}; if ( ! $opts{'noexpandxml'} ) { $value = SetupTools::expand_xml_var( $value, \%xmlvars ); } $value =~ s/'/'/g; $value =~ s/</\=2) { print "$ProgName done.\n"; } exit;