#!/usr/bin/env perl #----------------------------------------------------------------------------------------------- # # build-namelist # # The simplest use of build-namelist is to execute it from the build directory where configure # was run. By default it will use the config_cache.xml file that was written by # dice.cpl7.template to determine the build time properties of the executable, and will write # the files that contain the output namelists in that same directory. # # Date Contributor Modification # ------------------------------------------------------------------------------------------- # 2012-03-10 Vertenstein Updated for cesm1.1 #-------------------------------------------------------------------------------------------- use strict; #use warnings; #use diagnostics; use Cwd; use English; use Getopt::Long; use IO::File; use File::Basename; use Data::Dumper; #----------------------------------------------------------------------------------------------- sub usage { die < 0, silent => 0, caseroot => undef, scriptsroot => undef, inst_string => undef, ); GetOptions( "h|help" => \$opts{'help'}, "infile=s" => \$opts{'infile'}, "namelist=s" => \$opts{'namelist'}, "print=i" => \$opts{'print'}, "caseroot=s" => \$opts{'caseroot'}, "scriptsroot=s" => \$opts{'scriptsroot'}, "inst_string=s" => \$opts{'inst_string'}, ) or usage(); # Give usage message. usage() if $opts{'help'}; # Check for unparsed arguments if (@ARGV) { print "ERROR: unrecognized arguments: @ARGV\n"; usage(); } # Define print levels: # 0 - only issue fatal error messages # 1 - only informs what files are created (default) # 2 - verbose my $print = $opts{'print'}; my $eol = "\n"; my $CASEROOT = $opts{'caseroot'}; my $SCRIPTSROOT = $opts{'scriptsroot'}; my $INST_STRING = $opts{'inst_string'}; if ($print>=2) { print "Setting dice configuration script directory to $cfgdir$eol"; } #----------------------------------------------------------------------------------------------- # build empty config_cache.xml file (needed below) my $config_cache = "$CASEROOT/Buildconf/diceconf/config_cache.xml"; my $fh = new IO::File; $fh->open(">$config_cache") or die "** can't open file: $config_cache\n"; print $fh <<"EOF"; EOF $fh->close; if ($print>=1) { print "Wrote file $config_cache $eol"; } (-f "config_cache.xml") or die <<"EOF"; ** $ProgName - Cannot find configuration cache file: config_cache.xml\" ** EOF #----------------------------------------------------------------------------------------------- # Make sure we can find required perl modules, definition, and defaults files. # Look for them under the directory that contains the configure script. # The root directory to cesm utils Tools my $cesm_tools = &absolute_path( "$SCRIPTSROOT/ccsm_utils/Tools" ); # The XML::Lite module is required to parse the XML files. (-f "$cesm_tools/perl5lib/XML/Lite.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"XML/Lite.pm\" in directory \"$cesm_tools/perl5lib\" ** EOF # The Build::Config module provides utilities to access the configuration information # in the config_cache.xml file (-f "$cesm_tools/perl5lib/Build/Config.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"Build/Config.pm\" in directory \"$cesm_tools/perl5lib\" ** EOF # The namelist definition file contains entries for all namelist variables that # can be output by build-namelist. my $nl_definition_file = "$cfgdir/namelist_files/namelist_definition_dice.xml"; (-f "$nl_definition_file") or die <<"EOF"; ** $ProgName - Cannot find namelist definition file \"$nl_definition_file\" ** EOF if ($print>=2) { print "Using namelist definition file $nl_definition_file$eol"; } # The Build::NamelistDefinition module provides utilities to validate that the output # namelists are consistent with the namelist definition file (-f "$cesm_tools/perl5lib/Build/NamelistDefinition.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"Build/NamelistDefinition.pm\" in directory \"$cesm_tools/perl5lib\" ** EOF # The namelist defaults file contains default values for all required namelist variables. my $nl_defaults_file = "$cfgdir/namelist_files/namelist_defaults_dice.xml"; (-f "$nl_defaults_file") or die <<"EOF"; ** $ProgName - Cannot find namelist defaults file \"$nl_defaults_file\" ** EOF if ($print>=2) { print "Using namelist defaults file $nl_defaults_file$eol"; } # The Build::NamelistDefaults module provides a utility to obtain default values of namelist # variables based on finding a best fit with the attributes specified in the defaults file. (-f "$cesm_tools/perl5lib/Build/NamelistDefaults.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"Build/NamelistDefaults.pm\" in directory \"$cesm_tools//perl5lib\" ** EOF # The Build::Namelist module provides utilities to parse input namelists, to query and modify # namelists, and to write output namelists. (-f "$cesm_tools/perl5lib/Build/Namelist.pm") or die <<"EOF"; ** $ProgName - Cannot find perl module \"Build/Namelist.pm\" in directory \"$cesm_tools/perl5lib\" ** EOF #----------------------------------------------------------------------------------------------- # Add $cfgdir/perl5lib to the list of paths that Perl searches for modules my @dirs = ( "$cfgdir/..", "$cesm_tools/perl5lib"); unshift @INC, @dirs; require XML::Lite; require Build::Config; require Build::NamelistDefinition; require Build::NamelistDefaults; require Build::Namelist; require Streams::TemplateGeneric; #----------------------------------------------------------------------------------------------- # Create a configuration object from the DICE config_cache.xml file. my $cfg = Build::Config->new('config_cache.xml'); # Validate some of the commandline option values. validate_options("commandline", $cfg, \%opts); # Create a namelist definition object. This object provides a method for verifying that the # output namelist variables are in the definition file, and are output in the correct # namelist groups. my $definition = Build::NamelistDefinition->new($nl_definition_file); # Create a namelist defaults object. This object provides default values for variables # contained in the input defaults file. The configuration object provides attribute # values that are relevent for the DICE for which the namelist is being produced. my $defaults = Build::NamelistDefaults->new( $nl_defaults_file, $cfg); $defaults->add( "$nl_defaults_file" ); # Create an empty namelist object. Add values to it in order of precedence. my $nl = Build::Namelist->new(); #----------------------------------------------------------------------------------------------- # Process the user input in order of precedence. At each point we'll only add new # values to the namelist and not overwrite previously specified specified values which # have higher precedence. # Process the -namelist arg. if (defined $opts{'namelist'}) { # Parse commandline namelist my $nl_arg = Build::Namelist->new($opts{'namelist'}); # Validate input namelist -- trap exceptions my $nl_arg_valid; eval { $nl_arg_valid = $definition->validate($nl_arg); }; if ($@) { die "$ProgName - ERROR: Invalid namelist variable in commandline arg '-namelist'.\n $@"; } # Merge input values into namelist. Previously specified values have higher precedence # and are not overwritten. $nl->merge_nl($nl_arg_valid); } # Process the -infile arg. if (defined $opts{'infile'}) { foreach my $infile ( split( /,/, $opts{'infile'} ) ) { # Parse namelist input from a file my $nl_infile = Build::Namelist->new($infile); # Validate input namelist -- trap exceptions my $nl_infile_valid; eval { $nl_infile_valid = $definition->validate($nl_infile); }; if ($@) { die "$ProgName - ERROR: Invalid namelist variable in '-infile' $infile.\n $@"; } # Merge input values into namelist. Previously specified values have higher precedence # and are not overwritten. $nl->merge_nl($nl_infile_valid); } } #----------------------------------------------------------------------------------------------- #################################### # Required xml variables # #################################### my %xmlvars = (); my @files = <${CASEROOT}/*xml>; foreach my $file (@files) { my $xml = XML::Lite->new( "$file" ); my @e = $xml->elements_by_name('entry'); while ( my $e = shift @e ) { my %a = $e->get_attributes(); $xmlvars{$a{'id'}} = $a{'value'}; } } foreach my $attr (keys %xmlvars) { if ( $xmlvars{$attr} =~ m/\$/ ) {$xmlvars{$attr} = expand_env_xml($xmlvars{$attr});} if ( $xmlvars{$attr} =~ m/\$/ ) {$xmlvars{$attr} = expand_env_xml($xmlvars{$attr});} } my $RUN_TYPE = $xmlvars{'RUN_TYPE'}; my $DIN_LOC_ROOT = $xmlvars{'DIN_LOC_ROOT'}; my $ICE_DOMAIN_FILE = $xmlvars{'ICE_DOMAIN_FILE'}; my $ICE_DOMAIN_PATH = $xmlvars{'ICE_DOMAIN_PATH'}; my $ICE_GRID = $xmlvars{'ICE_GRID'}; my $DICE_MODE = $xmlvars{'DICE_MODE'}; (-d $DIN_LOC_ROOT) or die <<"EOF"; ** $ProgName - CCSM inputdata root is not a directory: \"$DIN_LOC_ROOT\" ** EOF if ($print>=2) { print " CESM inputdata root directory: $DIN_LOC_ROOT$eol"; print " dice_mode is $DICE_MODE \n"; print " dice grid is $ICE_GRID \n"; } #################################### # Streams file(s) # #################################### # Create input data list (written to later) my $input_data_list = "$CASEROOT/Buildconf/dice.input_data_list"; my $fh_out = new IO::File; $fh_out->open(">$CASEROOT/Buildconf/dice.input_data_list") or die "** can't open filepath file: dice.input_data_list\n"; # Create hash needed to parse namelist_defaults_dice.xml file my %default_namelist_opts; $default_namelist_opts{'dice_mode'} = $DICE_MODE; $default_namelist_opts{'ice_grid'} = $ICE_GRID; # Create streams template file(s) - loop over streams my $streams = $defaults->get_value( "streamslist", \%default_namelist_opts ); my @streams = split ",", $streams, -1; my $ostreams = undef; my $omapalgo = undef; my $omapmask = undef; my $otintalgo = undef; my $otaxmode = undef; my $ofillalgo = undef; my $ofillmask = undef; foreach my $stream ( @streams ) { # Set stream specific part of default_namelist_opts hash $default_namelist_opts{'stream'} = $stream; my $outstream = "dice.streams.txt" . ".$stream" . "$INST_STRING"; if ($print>=1) { print " dice stream is $stream$INST_STRING \n"; } if ($stream eq "NULL") { # do nothing } elsif (-e "$CASEROOT/user_$outstream") { my $command = "cp -p $CASEROOT/user_$outstream $CASEROOT/Buildconf/diceconf/$outstream"; system($command) == 0 or die "system $command failed: $? \n"; } else { # Create hash to initialze streams object my %stream_template_opts; if ( $print == 0 ) { $stream_template_opts{'printing'} = 0; } else { $stream_template_opts{'printing'} = 1; } $stream_template_opts{'test'} = $opts{'test'}; $stream_template_opts{'ProgName'} = $ProgName; $stream_template_opts{'ProgDir'} = "$cfgdir"; $stream_template_opts{'cmdline'} = $cmdline; $stream_template_opts{'offset'} = 0; $stream_template_opts{'filepath'} = $defaults->get_value( "strm_datdir" , \%default_namelist_opts ); $stream_template_opts{'filenames'} = $defaults->get_value( "strm_datfil" , \%default_namelist_opts ); $stream_template_opts{'domainpath'} = $defaults->get_value( "strm_domdir" , \%default_namelist_opts ); $stream_template_opts{'domain'} = $defaults->get_value( "strm_domfil" , \%default_namelist_opts ); $stream_template_opts{'datvarnames'}= $defaults->get_value( "strm_datvar" , \%default_namelist_opts ); $stream_template_opts{'domvarnames'}= $defaults->get_value( "strm_domvar" , \%default_namelist_opts ); $stream_template_opts{'yearfirst'} = $defaults->get_value( "strm_year_start", \%default_namelist_opts ); $stream_template_opts{'yearlast'} = $defaults->get_value( "strm_year_end" , \%default_namelist_opts ); $stream_template_opts{'filepath'} = expand_env_xml($stream_template_opts{'filepath'}); $stream_template_opts{'filenames'} = expand_env_xml($stream_template_opts{'filenames'}); $stream_template_opts{'domainpath'} = expand_env_xml($stream_template_opts{'domainpath'}); $stream_template_opts{'domain'} = expand_env_xml($stream_template_opts{'domain'}); $stream_template_opts{'yearfirst'} = expand_env_xml($stream_template_opts{'yearfirst'}); $stream_template_opts{'yearlast'} = expand_env_xml($stream_template_opts{'yearlast'}); # Create the streams txt file for this stream (from a generic template) my $stream_template = Streams::TemplateGeneric->new( \%stream_template_opts ); $stream_template->Read( "${CASEROOT}/Buildconf/dice.template.streams.xml" ); $stream_template->Write( $outstream ); # Append to dice.input_data_list my @filenames = $stream_template->GetDataFilenames( 'domain'); my $i = 0; foreach my $file ( @filenames ) { $i++; print $fh_out "domain${i} = $file\n"; } my @filenames = $stream_template->GetDataFilenames( 'data'); my $i = 0; foreach my $file ( @filenames ) { $i++; print $fh_out "file${i} = $file\n"; } } # Stream specific namelist variables used below for $nl my $tintalgo = $defaults->get_value( "strm_tintalgo" , \%default_namelist_opts); my $mapalgo = $defaults->get_value( 'strm_mapalgo' , \%default_namelist_opts); my $mapmask = $defaults->get_value( 'strm_mapmask' , \%default_namelist_opts); my $taxmode = $defaults->get_value( "strm_taxmode" , \%default_namelist_opts); my $fillalgo = $defaults->get_value( 'strm_fillalgo' , \%default_namelist_opts); my $fillmask = $defaults->get_value( 'strm_fillmask' , \%default_namelist_opts); my $dtlimit = $defaults->get_value( 'strm_dtlimit' , \%default_namelist_opts); my $beg_year = $defaults->get_value( 'strm_year_start', \%default_namelist_opts); my $end_year = $defaults->get_value( 'strm_year_end' , \%default_namelist_opts); my $align_year = $defaults->get_value( 'strm_year_align', \%default_namelist_opts); $beg_year = expand_env_xml($beg_year); $end_year = expand_env_xml($end_year); $align_year = expand_env_xml($align_year); if ( $beg_year > $end_year ) { print "\n\nbeg_year=$beg_year end_year=$end_year\n"; die "$ProgName ERROR:: beg_year greater than end_year\n"; } if ( ! defined($ostreams) ) { $ostreams = "\"$outstream $align_year $beg_year $end_year\""; $omapalgo = "\'$mapalgo\'"; $omapmask = "\'$mapmask\'"; $otintalgo = "\'$tintalgo\'"; $otaxmode = "\'$taxmode\'"; $ofillalgo = "\'$fillalgo\'"; $ofillmask = "\'$fillmask\'"; } else { $ostreams = "$ostreams,\"$outstream $align_year $beg_year $end_year\""; $omapalgo .= ",\'$mapalgo\'"; $omapmask .= ",\'$mapmask\'"; $otintalgo .= ",\'$tintalgo\'"; $otaxmode .= ",\'$taxmode\'"; $ofillalgo .= ",\'$fillalgo\'"; $ofillmask .= ",\'$fillmask\'"; } } $fh_out->close; ######################################################### # namelist group: shr_strdata_nml (in file dice_ice_in) # ######################################################### my $datamode = $defaults->get_value( "datamode", \%default_namelist_opts ); add_default($nl, 'datamode', 'val' => "$datamode" ); add_default($nl, 'domainfile', 'val' => "$ICE_DOMAIN_PATH/$ICE_DOMAIN_FILE"); if ($datamode ne 'NULL') { add_default($nl, 'streams', 'val' => "$ostreams" ); add_default($nl, 'mapalgo', 'val' => "$omapalgo" ); add_default($nl, 'mapmask', 'val' => "$omapmask" ); add_default($nl, 'tintalgo', 'val' => "$otintalgo" ); add_default($nl, 'taxmode', 'val' => "$otaxmode" ); add_default($nl, 'fillalgo', 'val' => "$ofillalgo" ); add_default($nl, 'fillmask', 'val' => "$ofillmask" ); } ############################################## # namelist group: dice_nml (in file dice_in) # ############################################## add_default($nl, 'ice_in', 'val'=>"dice_ice_in$INST_STRING"); add_default($nl, 'decomp'); add_default($nl, 'flux_qacc'); if ( $RUN_TYPE =~ /branch/ ) { # The dice master restart file is currently unused #if (not defined $nl->get_value('restfilm')) { # die "$ProgName ERROR:: restfilm is required for a branch type.\n"; #} } #----------------------------------------------------------------------------------------------- # Validate that the entire resultant namelist is valid # $definition->validate($nl); #----------------------------------------------------------------------------------------------- # Write output files # my $note = ""; # dice_ice_in my @groups = qw(shr_strdata_nml); my $outfile = "./dice_ice_in"; $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); if ($print>=2) { print "Writing dice_dshr namelist to $outfile $eol"; } # dice_in @groups = qw(dice_nml); $outfile = "./dice_in"; $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); if ($print>=2) { print "Writing dice_in namelist to $outfile $eol"; } # ice_modelio @groups = qw(modelio); $outfile = "./ice_modelio.nml"; $nl->set_variable_value( "modelio", "logfile", "'ice.log'" ); $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); if ($print>=2) { print "Writing ice_modelio.nml namelist to $outfile $eol"; } # Write out required local input files check_input_files($nl, $DIN_LOC_ROOT, "$CASEROOT/Buildconf/dice.input_data_list"); #=============================================================================================== #=============================================================================================== # END OF MAIN SCRIPT #=============================================================================================== #=============================================================================================== sub add_default { # Add a value for the specified variable to the specified namelist object. The variables # already in the object have the higher precedence, so if the specified variable is already # defined in the object then don't overwrite it, just return. # # This method checks the definition file and adds the variable to the correct # namelist group. # # The value can be provided by using the optional argument key 'val' in the # calling list. Otherwise a default value is obtained from the namelist # defaults object. If no default value is found this method throws an exception # unless the 'nofail' option is set true. # # Example 1: Specify the default value $val for the namelist variable $var in namelist # object $nl: # # add_default($nl, $var, 'val'=>$val) # # Example 2: Add a default for variable $var if an appropriate value is found. Otherwise # don't add the variable # # add_default($nl, $var, 'nofail'=>1) # # # ***** N.B. ***** This routine assumes the following variables are in package main:: # $definition -- the namelist definition object # $defaults -- the namelist defaults object # $DIN_LOC_ROOT -- CESM inputdata root directory my $nl = shift; # namelist object my $var = shift; # name of namelist variable my %opts = @_; # options # If variable has quotes around it if ( $var =~ /'(.+)'/ ) { $var = $1; } # Query the definition to find which group the variable belongs to. Exit if not found. my $group = $definition->get_group_name($var); unless ($group) { my $fname = $definition->get_file_name(); die "$ProgName - ERROR: variable \"$var\" not found in namelist definition file $fname.\n"; } # check whether the variable has a value in the namelist object -- if so then skip to end my $val = $nl->get_variable_value($group, $var); if (! defined $val) { # Look for a specified value in the options hash if (defined $opts{'val'}) { $val = $opts{'val'}; } # or else get a value from namelist defaults object. # Note that if the 'val' key isn't in the hash, then just pass anything else # in %opts to the get_value method to be used as attributes that are matched # when looking for default values. else { $val = $defaults->get_value($var, \%opts); # Truncate model_version appropriately if ( $var eq "model_version" ) { $val =~ /(URL: https:\/\/[a-zA-Z0-9._-]+\/)([a-zA-Z0-9\/._-]+)(\/bld\/.+)/; $val = $2; } } unless ( defined($val) ) { unless ($opts{'nofail'}) { die "$ProgName - No default value found for $var.\n" . " Are defaults provided? \n"; } else { return; } } # query the definition to find out if the variable is an input pathname my $is_input_pathname = $definition->is_input_pathname($var); # The default values for input pathnames are relative. If the namelist # variable is defined to be an absolute pathname, then prepend # the CESM inputdata root directory. if (not defined $opts{'no_abspath'}) { if (defined $opts{'set_abspath'}) { $val = set_abs_filepath($val, $opts{'set_abspath'}); } else { if ($is_input_pathname eq 'abs') { $val = set_abs_filepath($val, $DIN_LOC_ROOT); } } } # query the definition to find out if the variable takes a string value. # The returned string length will be >0 if $var is a string, and 0 if not. my $str_len = $definition->get_str_len($var); # If the variable is a string, then add quotes if they're missing if ($str_len > 0) { $val = quote_string($val); } # set the value in the namelist $nl->set_variable_value($group, $var, $val); } } #----------------------------------------------------------------------------------------------- sub check_input_files { # For each variable in the namelist which is an input dataset, check to see if it # exists locally. # # ***** N.B. ***** This routine assumes the following variables are in package main:: # $definition -- the namelist definition object my $nl = shift; # namelist object my $inputdata_rootdir = shift; # if false prints test, else creates inputdata file my $outfile = shift; open(OUTFILE, ">>$outfile") if defined $inputdata_rootdir; # Look through all namelist groups my @groups = $nl->get_group_names(); foreach my $group (@groups) { # Look through all variables in each group my @vars = $nl->get_variable_names($group); foreach my $var (@vars) { # Is the variable an input dataset? my $input_pathname_type = $definition->is_input_pathname($var); # If it is, check whether it exists locally and print status if ($input_pathname_type) { # Get pathname of input dataset my $pathname = $nl->get_variable_value($group, $var); # Need to strip the quotes $pathname =~ s/[\'\"]//g; if ($input_pathname_type eq 'abs') { if ($inputdata_rootdir) { print OUTFILE "$var = $pathname\n"; } else { if (-e $pathname) { # use -e rather than -f since the absolute pathname # might be a directory print "OK -- found $var = $pathname\n"; } else { print "NOT FOUND: $var = $pathname\n"; } } } elsif ($input_pathname_type =~ m/rel:(.+)/o) { # The match provides the namelist variable that contains the # root directory for a relative filename my $rootdir_var = $1; my $rootdir = $nl->get_variable_value($group, $rootdir_var); $rootdir =~ s/[\'\"]//g; if ($inputdata_rootdir) { $pathname = "$rootdir/$pathname"; print OUTFILE "$var = $pathname\n"; } else { if (-f "$rootdir/$pathname") { print "OK -- found $var = $rootdir/$pathname\n"; } else { print "NOT FOUND: $var = $rootdir/$pathname\n"; } } } } } } close OUTFILE if defined $inputdata_rootdir; return 0 if defined $inputdata_rootdir; } #----------------------------------------------------------------------------------------------- sub set_abs_filepath { # check whether the input filepath is an absolute path, and if it isn't then # prepend a root directory my ($filepath, $rootdir) = @_; # strip any leading/trailing whitespace $filepath =~ s/^\s+//; $filepath =~ s/\s+$//; $rootdir =~ s/^\s+//; $rootdir =~ s/\s+$//; # strip any leading/trailing quotes $filepath =~ s/^['"]+//; $filepath =~ s/["']+$//; $rootdir =~ s/^['"]+//; $rootdir =~ s/["']+$//; my $out = $filepath; unless ( $filepath =~ /^\// ) { # unless $filepath starts with a / $out = "$rootdir/$filepath"; # prepend the root directory } return $out; } #----------------------------------------------------------------------------------------------- sub absolute_path { # # Convert a pathname into an absolute pathname, expanding any . or .. characters. # Assumes pathnames refer to a local filesystem. # Assumes the directory separator is "/". # my $path = shift; my $cwd = getcwd(); # current working directory my $abspath; # resulting absolute pathname # Strip off any leading or trailing whitespace. (This pattern won't match if # there's embedded whitespace. $path =~ s!^\s*(\S*)\s*$!$1!; # Convert relative to absolute path. if ($path =~ m!^\.$!) { # path is "." return $cwd; } elsif ($path =~ m!^\./!) { # path starts with "./" $path =~ s!^\.!$cwd!; } elsif ($path =~ m!^\.\.$!) { # path is ".." $path = "$cwd/.."; } elsif ($path =~ m!^\.\./!) { # path starts with "../" $path = "$cwd/$path"; } elsif ($path =~ m!^[^/]!) { # path starts with non-slash character $path = "$cwd/$path"; } my ($dir, @dirs2); my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls # This enables correct processing of the input "/". # Remove any "" that are not leading. for (my $i=0; $i<=$#dirs; ++$i) { if ($i == 0 or $dirs[$i] ne "") { push @dirs2, $dirs[$i]; } } @dirs = (); # Remove any "." foreach $dir (@dirs2) { unless ($dir eq ".") { push @dirs, $dir; } } @dirs2 = (); # Remove the "subdir/.." parts. foreach $dir (@dirs) { if ( $dir !~ /\.\./ ) { push @dirs2, $dir; } else { pop @dirs2; # remove previous dir when current dir is .. } } if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; } $abspath = join '/', @dirs2; return( $abspath ); } #------------------------------------------------------------------------------- sub valid_option { my ($val, @expect) = @_; my ($expect); $val =~ s/^\s+//; $val =~ s/\s+$//; foreach $expect (@expect) { if ($val =~ /^$expect$/i) { return $expect; } } return undef; } #------------------------------------------------------------------------------- sub validate_options { my $source = shift; # text string declaring the source of the options being validated my $cfg = shift; # configure object my $opts = shift; # reference to hash that contains the options my ($opt, $old, @expect); } #------------------------------------------------------------------------------- sub quote_string { my $str = shift; $str =~ s/^\s+//; $str =~ s/\s+$//; unless ($str =~ /^['"]/) { #"' $str = "\'$str\'"; } return $str; } #------------------------------------------------------------------------------- sub expand_env_xml { my $value = shift; if ($value =~ /\$([\w_]+)(.*)$/) { my $subst = $xmlvars{$1}; $value =~ s/\$${1}/$subst/g; } return $value; }