!---------------------------------------------------------------------------- ! ! resolve_env -- Resolve environment variables in a path or general string. ! ! 1.00 2008-dec-17 Original hasty version. By Dave Allured. ! This version handles only a single environment ! variable at the beginning of the string. ! 1.01 2010-may-04 Bug fix for single env. var. with no trailing slash. ! 1.02 2010-dec-16 Fix compiler warning for unused future parameter. ! ! This routine substitutes environment variables in a path name ! or general string. Any number of environment variables may ! be included. Environment variables are specified in the usual ! Unix way as $name. ! ! Variable syntax and substituion are similar to the Unix shell, but ! simpler. Only a few delimiters and syntax features are supported. ! ! Substitution is done recursively. If one substitution contains ! new references to environment variables, then those will also be ! resolved. ! ! A reference to an undefined environment variable is left unchanged. ! This will result in a dollar sign ($) left in the output string. ! ! Errors result in diagnostic message and program abort. The only ! known error condition is string capacity exceeded. The argument ! string must be long enough to hold the fully resolved result string. ! !---------------------------------------------------------------------------- module resolve__env contains subroutine resolve_env (string) implicit none character(*), intent (inout) :: string ! string with $var's; ! overwritten with result string ! Local parameters and variables. !! For a later version: !! character(*), parameter :: delimiters = '$ !*./,;[]{}"' ! supported delimiters to terminate the var name character (len=len(string)) :: varname, value, temp integer remain, outlen, base, p2, len2 ! Initialize. remain = len_trim (string) ! start at full non-blank length ! of input string outlen = len (string) ! get available string length base = 1 ! set base pointer to start of string ! *** QUICK FIX -- RESOLVE ONLY A SINGLE LEADING ENVIRONMENT VARIABLE *** ! E.G. $varname/xxx RESOLVES TO value/xxx p2 = index (string, '/') ! find first slash in string if (p2 == 0) p2 = len_trim (string) + 1 ! handle no trailing slash if (string(1:1) /= '$' .or. p2 < 3) return ! skip if no leading env var varname = string(2:p2-1) ! extract varname from "$varname/" call getenv (trim (varname), value) ! get value for this env var ! If environment var exists, then make the substitution. if (value /= ' ') then value = adjustl (value) ! no funny business with leading spaces len2 = len_trim (value) ! get real length of substring temp = string(p2:) ! get slash plus remainder of string string = value ! insert substitution at beginning string(len2+1:) = temp ! insert remainder including slash end if ! If substitution NOT made, then the original string is left intact. end subroutine resolve_env end module resolve__env