install.tcl

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

                if {"$setAllFlag" == "1"} {
                    foreach partIndex [productInfoGet partIndexList $prodIndex] {
                        partInfoSet instFlag $partIndex 1
                        set pickList(part,$partIndex) 1
                    }
                }

            } else {
                set productObj($prodIndex,instFlag) $value
            }
        }

        stateCommit {
            set productObj($prodIndex,prevInstFlag) \
            $productObj($prodIndex,instFlag)
            }

        stateRestore {
            set productObj($prodIndex,instFlag) \
            $productObj($prodIndex,prevInstFlag)
            }

        childStateCommit {
            foreach partIndex $productObj($prodIndex,partIndexList) {
                partInfoSet stateCommit $partIndex
            }
        }

        childStateRestore {
            foreach partIndex $productObj($prodIndex,partIndexList) {
                partInfoSet stateRestore $partIndex
            }
        }

        default { puts "productInfoSet: unknown info: $info" }
    }
}

##############################################################################
#
# partInfoGet - returns the requested attribute of a part object.
#
# Attribute      Meaning
# ---------      -------
# instFlag       a toggle flags that indicate a selection state of a part
# prevInstFlag   a previous state of the above flag
# desc           a part description
# parent         an integer that identifies the parent product
# size           a total size of a part
# totalFile      a total number of files of a part
#
# SYNOPSIS
# partInfoGet <attrib> <partIndex>
#
# PARAMETERS:
#    <attrib> : a part object's attribute
#    <partIndex> : an integer indentifies a part
#
# RETURNS: requested attribute
#
# ERRORS: N/A
#

proc partInfoGet {info partIndex} {
    global partObj

    switch $info {
        instFlag { return $partObj($partIndex,instFlag) }

        prevInstFlag { return $partObj($partIndex,prevInstFlag) }

        desc { return $partObj($partIndex,desc) }

        parent { return $partObj($partIndex,parent) }

        size {
            if [isUnix] {
                return $partObj($partIndex,size)
            } else {

            # this option returns the estimated size of a part takes up
            # on a Windows file system. A file with 10 bytes can take up to
            # 32768 bytes on a FAT system.
            # On average, each file in tornado wastes 78% of one block.
            # For each file in the part, it adds 78% of the system's
            # block size to the file size to account for the extra bytes

            return  [format %.f [expr $partObj($partIndex,totalFile) * \
                    [setupClusterSizeGet [rootDirGet [destDirGet]]] * \
                    0.78 + $partObj($partIndex,size)]]
            }
        }

        totalFile { return $partObj($partIndex,totalFile) }

        coreProd { return $partObj($partIndex,coreProd) }

        default { puts "partInfoGet: unknown info: $info" }
    }
}

##############################################################################
#
# rootDirGet - returns the root directory or the drive letter for
#              a specified path on Windows machines.
#
# SYNOPSIS
# partInfoSet <path>
#
# PARAMETERS:
#    <path> : a directory pathes
#
# RETURNS: root directory
#
# ERRORS: N/A
#

proc rootDirGet {path} {

    regexp {^(.*)\:(.*)$} $path junk root dir
    if { [info exists root] && "$root" != "" } {
        return "$root:\\"
    } else {
        return "c:\\"
    }
}

##############################################################################
#
# partInfoSet - changes an attribute of a part object
#
# see partInfoGet() for available attribute of a part object
#
# SYNOPSIS
# partInfoSet <attrib> <partIndex> [value]
#
# PARAMETERS:
#    <attrib> : an attribute of a part object
#    <partIndex> : an integer that identifies a part
#    [value] : new attribute value
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc partInfoSet {info partIndex {value ""}} {
    global partObj pickList

    switch $info {
        instFlag { set partObj($partIndex,instFlag) $value }

        desc { set partObj($partIndex,desc) $value }

        parent { set partObj($partIndex,parent) $value }

        stateCommit {
            set partObj($partIndex,prevInstFlag) \
            $partObj($partIndex,instFlag)
            }

        stateRestore {
            set partObj($partIndex,instFlag) $partObj($partIndex,prevInstFlag)
            set pickList(part,$partIndex) $partObj($partIndex,prevInstFlag)
        }

        default { puts "partInfoSet: unknown info: $info" }
    }
}

##############################################################################
#
# stateInfoHelper -  determents if a selection state is changing
#
# By comparing the total size of the current and previous selection state, this
# function helps reduce unnesscessary GUI updating.
#
# SYNOPSIS
# stateInfoHelper <state> <totalCurr> <totalPrev>
#
# PARAMETERS:
#    <state> : curent state
#    <totalCurr> : total size in current state
#    <totalPrev> : total size in previous state
#
# RETURNS: new state.
#
# ERRORS: N/A
#

proc stateInfoHelper {state totalCurr totalPrev} {
    set retVal $state

    if {"$state" != "unchanged"} {

        if {"$totalCurr" == "0"} {
            set retVal "${state}ToNone"

        } elseif {"$totalCurr" >= "$totalPrev"} {
            set retVal "${state}Incr"

        } elseif {"$totalCurr" < "$totalPrev"} {
             set retVal "${state}Decr"
        }
    }

    return $retVal
}

##############################################################################
#
# objectDump - dumps out to stdout all object information
#
# SYNOPSIS
# objectDump
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc objectDump {} {
    global objGuiMap partObj productObj

    puts ""

    foreach elem [lsort [array names objGuiMap]] {
        puts "objGuiMap($elem) = $objGuiMap($elem)"
    }

    foreach elem [lsort [array names partObj]] {
        puts "partObj($elem) = $partObj($elem)"
    }

    foreach elem [lsort [array names productObj]] {
        puts "productObj($elem) = $productObj($elem)"
    }
}

##############################################################################
#
# cdNameGet - read CD part number from DISK_ID file written to by mfg
#
# SYNOPSIS
# cdNameGet
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc cdNameGet {{mode number}} {
    global setupVals env

    set setupVals(runFromCD) 1

    set file [cdromRootDirGet]/DISK_ID

    if {[file exists "$file"] && ![catch {open "$file" "r"} f]} {
        gets $f setupVals(CDnumber)
        gets $f setupVals(CDdescription)
        gets $f setupVals(CDManufacturingTime)
        catch { close $f } err

        # preceed quotes with escape characters
        regsub -all {\"} $setupVals(CDdescription) {\\"} setupVals(CDdescription)

        switch $mode {
            number { return $setupVals(CDnumber) }
            description { return $setupVals(CDdescription) }
            time { return $setupVals(CDManufacturingTime) }
            default { return "" }
        }

    } else {
        # here, no DISK_ID found. Must be running from the tree.

        set setupVals(runFromCD) 0

        if { [isTornadoProduct] } {
            # set wind base
            set env(WIND_BASE) [file dirname [cdromRootDirGet]]
            dbgputs "run from the installed tree. WIND_BASE is $env(WIND_BASE)"

        } else {
            destDirSet [file dirname [cdromRootDirGet]]
            dbgputs "run from the installed tree. Destination directory is [destDirGet]"
        }

        if { $setupVals(lmError) != "" || [instTypeGet] == "licenseSetup"} {

            if { [isTornadoProduct] } {
                destDirSet $env(WIND_BASE)
            } else {
                destDirSet [file dirname [cdromRootDirGet]]
                dbgputs "run from the installed tree"
            }

            # if in lmError page, use CD info from setup.log

            set setupVals(CDnumber) ""

            # get WIND_BASE

            if { [isTornadoProduct] } {
                if { [info exist env(WIND_BASE)] } {
                    set setupLog [file join $env(WIND_BASE) setup.log]
                } else {
                    messageBox "Error: WIND_BASE variable is not set!"
                    return ""
                }
            } else {
                set setupLog [file join [destDirGet] setup.log]
            }

            # try opening setup.log file

            if [catch {open $setupLog r} logfd] {
                messageBox "Error: cannot open file $setupLog!"
                return ""
            } else {
                set text [split [read $logfd] \n]
                set nlines [llength $text]
                close $logfd
                                
                for {set ix 0} {$ix < $nlines} {incr ix} {
                                        
                    # iterate each line and search for CD info
                    set textLine [split [lindex $text $ix]]
                                        
                    # search for line that begins with "TDK"
                    if { [lsearch -regexp $textLine "TDK-"] == 1} {
                                                
                        # get CD number
                        set setupVals(CDnumber) [split [lindex $textLine 1]]
                                                
                        # get CD description (next line)
                        set nextLine [split [lindex $text [expr $ix + 1]]]
                        set endB [expr [llength $nextLine] - 1]
                        set setupVals(CDdescription) [split [lrange $nextLine 1 $endB]]
                    }
                }
            }
                        
            switch $mode {
                number { return $setupVals(CDnumber) }
                description { return $setupVals(CDdescription) }
                default { return "" }
            }
        } else {
            return ""
        }
    }
}

######################################################################
# Dialog Text Messages
######################################################################

set strTable(BACKUP_DISK_FULL_WARN) \
    "SETUP is attempting to backup previously installed files, but\
     no disk space is available.  Free some disk space and press OK\
     to continue, or press Cancel to skip backing up files.\n\n\
     NOTE: If you cancel backup of files, performing an Uninstall to\
     the previous session will be invalid."

set strTable(TEMP_DISK_FULL_WARN) \
    "There may not be enough space available under temporary directory.\
     Please click \"OK\" to exit SETUP, clear temporary directory, and \
     try running SETUP again."

#
# initialize globals
#

source [cdromRootDirGet]/RESOURCE/TCL/VERSION.TCL
global overwritePolicy
catch {unset overwritePolicy}
set overwritePolicy(ALL) 0
set setupVals(uninstLog) 0

#
# loading setup agent
#
load  [cdromBinDirGet]/SETUPTCL[string toupper [info sharedlibextension]]