inf.tcl

vxworks下MV5500的BSP支持包。是支持tornad221下的版本。

# inf.tcl - Setup routines to process inf files.
#
# Copyright 1998 Wind River Systems, Inc
#
# Modification history
# --------------------
# 03b,13jul02,wmd  Change setup log message for failure to start service to
#                  say "Unable to confirm..."
# 03a,12jun01,j_w  Modified for Tornado 2.2
# 02a,21jun00,bjl  Added int option to addRegistryLine.
# 01z,31may00,j_w  Enabled the Tornado Registry Service to be re-started right
#                  after removal (SPR 31316)
# 01y,16mar00,bwd  Changed patch checking to support only Solaris 2.7
# 01x,21oct99,bjl  removed parisc-hpux support.
# 01w,13oct99,bjl  process TORNADO.INF for tornado-* products in
#                  searchAndProcessSection.
# 01v,22mar99,bjl  do not write to uninstall log for first reg subkey.
# 01u,19mar99,wmd  Debug message writes to a file instead.
# 01t,08mar98,wmd  added work-around to get setup running on HPUX, don't
#                  redirect output to a file using exec.
# 01s,03mar99,wmd  Place catches around exec calls.
# 01r,24feb99,bjl  fixed default registry values to be empty when no values
#                  are specified.
# 01q,21feb99,bjl  fixed creation of first subkey directly below root key
#                  in the windows registry.
# 01p,01feb99,bjl  replaced ampersandReplace with subspecSpecialCharReplace.
# 01o,08jan99,bjl  replace ampersands in regsub subspecs (fixes spr 24217).
# 01n,09dec98,bjl  enhanced HPUX patch checking to check for list of
#                  patch numbers or use patch description.
# 01m,04dec98,bjl  limit Solaris 2.6 patch checking to 2.6 instead of 2.6.x.
# 01l,11nov98,bjl  added processing of ALLPRODUCTS.INF to
#                  selectedProductsProcessInfFile.
# 01k,27oct98,bjl  added patch checking for HPUX 10, added required
#                  and recommended criteria to patch checking.
# 01j,25sep98,bjl  added required patch checking for Solaris.
# 01i,15sep98,bjl  swapped args and dir position for addIconLine.
# 01h,09sep98,bjl  added os version to filesCopy, account for unix paths.
# 01g,03sep98,bjl  changed inf filenames to uppercase.
# 01f,13aug98,bjl  added infputs wrapper and changed all puts to infputs.
# 01e,13aug98,tcy  added extra argument "args" for linkCreateLog
# 01d,12aug98,tcy  changed function calls in accordance with new OLE-based SETUP
# 01c,11aug98,tcy  unixified
# 01b,04aug98,bjl  added WarningsFile and InstallLast sections, tab cleanup.
# 01a,26jul98,bjl  written.
#

#############################################################################
#
# extractSectionName - extract the section name between the brackets
#
# This procedure will extract the section name between the brackets.
#
# SYNOPSIS
# extractSectionName <bracketedName>
#
# PARAMETERS:
#   bracketedName : a section name in between brackets
#
# RETURNS: the section name without brackets
#
# ERRORS: N/A
#

proc extractSectionName {bracketedName} {
    regexp {[^[]+} $bracketedName extractedName
    regexp {[^]]+} $extractedName extractedName
    return $extractedName
}


#############################################################################
#
# readLine - read the next line with data.
#
# This procedure will read and return the next line from the inf file
# containing valid data.  Blank lines are skipped.
#
# SYNOPSIS
# readLine
#
# PARAMETERS: N/A
#
# RETURNS: sucessfully read line from inf file.
#
# ERRORS: N/A
#

proc readLine {} {
    global infFileId

    set lineRead 0

    # skip over blank lines
    while {$lineRead == 0} {
        set lineRead [gets $infFileId line]
    }

    return $line
}

#############################################################################
#
# openFile - open the inf file for processing.
#
# Opens the inf file specified by <fileName> and sets the global
# inf file id.
#
# SYNOPSIS
# openFile <fileName>
#
# PARAMETERS:
#   fileName : name of the inf file to open.
#
# RETURNS:
#   0 if <fileName> cannot be opened.
#   1 if successful.
#
# ERRORS: N/A
#

proc openFile {fileName} {
    global infFileId

    if [catch {open $fileName r} infFileId] {
        infputs "INF processing: Cannot open INF file $fileName"
        return 0
    }
    return 1
}

#############################################################################
#
# closeFile - closes the inf file being processed
#
# Closes the current inf file being processed, which is specified
# by the global variable infFileId.
#
# SYNOPSIS
# closeFile
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc closeFile {} {
    global infFileId

    close $infFileId
}

#############################################################################
#
# getLineType - returns the line type of the specified line.
#
# Returns whether the line contains a comment, section name, or data.
#
# SYNOPSIS
# getLineType <line>
#
# PARAMETERS:
#   line : a line read from the inf file.
#
# RETURNS:
#   "comment" if the line is a comment (begins with ";")
#   "section_name" if the line contains a section name (begins with "[")
#   "data" for all other cases
#   "end_of_file" if the end of the file has been reached
#
# ERRORS: N/A
#

proc getLineType {line} {
    # end of file does not register as a blank line for readLine
    if {[endOfFile]} {
        return end_of_file
    }

    # get the first character that is not a space or tab
    regexp {[^ \t]} $line firstCharacter

    switch -exact -- $firstCharacter {
        ;       { return comment }
        [       { return section_name }
        default { return data }
    }
}

#############################################################################
#
# endOfFile - returns whether the end of the inf file has been reached.
#
# Returns whether the end-of-file has been reached for the current inf file
# begin processed.
#
# SYNOPSIS
# endOfFile
#
# PARAMETERS: N/A
#
# RETURNS:
#   0 if eof has not been reached
#   1 if eof has been reached
#
# ERRORS: N/A
#

proc endOfFile {} {
    global infFileId

    return [eof $infFileId]
}


#############################################################################
#
# subspecSpecialCharReplace - replace all special characeters within a
#                             string to be used as a regsub subspec.
#
# For a given string that is to be used as a subspec for the regsub
# command, this procedure replaces all special characters within
# the string so that they retain their literal value.
#
# All occurences of slashes are first replaced with four slashes.  Oddly
# for the latest Tcl (8.0), this ensures that a literal slash is preserved
# through the regsub, rather than becoming part of a character
# interpretation.
#
# All occurrences of & are replaced with \&.  A plain & in a subspec is
# replaced with the string that matched the pattern.
#
# SYNOPSIS
# subspecSpecialCharReplace <value>
#
# PARAMETERS:
#   value : a string with possible special characters to be replaced.
#
# RETURNS:
#   A new value in which special characters have been replaced so they
#   retain their literal values during a regsub, if the value is used as a
#   replacement pattern (subspec).
#
# ERRORS: N/A
#

proc subspecSpecialCharReplace {value} {

    regsub -all {\\} $value {\\\\} value
    regsub -all & $value \\\\& value
    return $value
}

#############################################################################
#
# percentEvaluate - evaluates substring values between percent signs.
#
# For a given string, this procedure evaluates and replaces all substrings
# between percent signs.  A new string containing the replaced substrings is
# returned.
#
# The order of evaluation for each substring is as follows:
#   1. the substring is replaced with the value specified in the Strings
#      section of the inf file.
#   2. if the substring is a procedure name, it is replaced with its return
#      value.
#   3. if the substring is a global variable, it is replaced with its value.
#
# SYNOPSIS
# percentEvaluate <value>
#
# PARAMETERS:
#   value : a string with possible substrings between % signs
#
# RETURNS:
#   A new string with substrings between % signs replaced with their
#   evaluated strings.  If a substring between % signs cannot be replaced,
#   the original string is returned.
#
#
# ERRORS: N/A
#

proc percentEvaluate {value} {
    global infString

    while {[regexp {%[^%]+%} $value evaluation_subspec] != 0} {
        regexp {[^%]+} $evaluation_subspec valueToEvaluate

        # check if infString, procedure, or variable exists
        set infStringExists [info exists infString($valueToEvaluate)]
        set functionExists [info procs $valueToEvaluate]

        # allow checking of arrays - check for array variable format
        if {[regexp {[^()]+\([^(]+\)} $valueToEvaluate != 0]} {
            regexp {[^\(]+} $valueToEvaluate arrayName
            global $arrayName
        } else {
            global $valueToEvaluate
        }
        set variableExists [info exists $valueToEvaluate]

        # do the evaluation
        if {$infStringExists == 1} {
            regsub {%[^%]+%} $value [subspecSpecialCharReplace $infString($valueToEvaluate)] value
        } elseif {[string length $functionExists] > 0} {
            regsub {%[^%]+%} $value [subspecSpecialCharReplace [$valueToEvaluate]] value
        } elseif {$variableExists == 1} {
            regsub {%[^%]+%} $value [subspecSpecialCharReplace [set $valueToEvaluate]] value
        } else {
            infputs "INF processing: %$valueToEvaluate% is not specified"
            infputs "in the Strings section, is not a procedure, and is not a"
            infputs "global variable."
            return $value
        }
    }
    return $value
}

#############################################################################
#
# nthValueFromCommaDelimitedLine - returns the nth value of a comma delimited
#                                  list
#
# For a list of values separated by commas, returns the nth value in the
# list.  Whitespace preceding each value is accounted for.  Substrings
# for each value in between % signs are replaced by calling the
# procedure percentEvaluate.
#
#
# SYNOPSIS
# nthValueFromCommaDelimitedLine <line> <index>
#
# PARAMETERS:
#   line : a string of comma delimited values
#   index : specifies the nth value to be returned.  The index starts with
#           1 (the first value in the list).
#
# RETURNS:
#   The nth value specified by <index>.
#   "no_value" if the value specified by index does not exist.
#
# ERRORS: N/A
#

proc nth {line index} {
    return [nthValueFromCommaDelimitedLine $line $index]
}

proc nthValueFromCommaDelimitedLine {line index} {

    # count the number of commas.  If the number is less than
    # the index-1, the index value does not exist.
    set numcommas [regsub -all , $line {} ignore]
    if {$numcommas < [expr $index - 1]} {
        return no_value
    }

    set value [lindex [split $line ,] [expr $index - 1]]

    # remove prefixing spaces or tabs
    regexp "\[^ \t\]+.*" $value value

    if {[string length $value] == 0 } {
        return no_value
    }

    # make sure value does not consist of just spaces or tabs
    if {[regexp "\[^ \t\]+" $value]==0} {
        return no_value
    }

    # evaluate all strings between percent signs
    set value [percentEvaluate $value]

    return $value
}

#############################################################################