global.tcl

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

# PARAMETERS: path
#
# RETURNS:  the size of given directory or 0 if path is not a directory
#
# ERRORS: N/A
#

proc dirSizeGet {path} {

    if {[file isdirectory $path] == 0} {
        return 0
    }

    set totsz 0
    set list [glob $path/*]

    foreach file $list {
        set totsz [expr $totsz + [file size [file join $path $file]]]
    }
    return $totsz
}


##############################################################################
#
# setupSizeGet - returns the size of setup directory
#
# This routine returns the size of setup directory
#
# SYNOPSIS:
# setupSizeGet
#
# PARAMETERS: N/A
#
# RETURNS:  the size of setup directory
#
# ERRORS: N/A
#

proc setupSizeGet {} {

    set docSize 0
    set path [file join [cdromRootDirGet] DOCS]
    set docSize [byteToMbyte [dirSizeGet $path]]

    switch [windHostTypeGet] {
        x86-win32 {
            return [expr 10.9 + $docSize]
        }
        sun4-solaris2 {
            return [expr 13.0 + $docSize]
        }
        parisc-hpux10 {
            return [expr 14.3 + $docSize]
        }
        default {
            return [expr 10.9 + $docSize]
        }
    }
}

##############################################################################
#
# instTypeSet - sets the installation type.
#
# Sets the global variable instType to the installation type (for example,
# "icon" for an icon-only installation).
#
# SYNOPSIS:
# instTypeSet type
#
# PARAMETERS:
# <type>
# The installation type.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc instTypeSet {type} {
    global instType

    set instType $type
}

##############################################################################
#
# instTypeGet - returns the installation type.
#
# This routine returns the installation type (for example, "icon" for
# an icon-only installation).  If the installation type has not been
# set, an empty string is returned.
#
# SYNOPSIS:
# userNameGet
#
# PARAMETERS: N/A
#
# RETURNS: the installation type if it exists, else an empty string.
#
# ERRORS: N/A
#

proc instTypeGet {} {
    global instType

    if ![info exists instType] {
        set instType ""
    }

    return $instType
}

##############################################################################
#
# checkPathLen - checks the path length and trims the path if necessary.
#
# This routine checks the length of a given path.  If the length is
# over 50 characters, part of the path is replaced with "..."  This
# allows a long path to fit in a dialog window.
#
# SYNOPSIS:
# checkPathLen path
#
# PARAMETERS:
# <path>
# A directory path.
#
# RETURNS: The original path partially replaced with "..." if over
#          50 characters.
#
# ERRORS: N/A
#

proc checkPathLen {path} {

    if {[string length $path] >= 50} {
        set totLen [string length $path]
        set lastIndex [string last "/" $path]
        if {$lastIndex > [string last "\\" $path]} {
            # Unix type path

            set path2 [string range $path 0 [expr $lastIndex - 1]]
            set fname [string range $path [expr $lastIndex + 1] $totLen]
            set lastIndex2 [string last "/" $path2]
            while {[expr [string length $path2] + [string length $fname] + 5] \
                >= 50} {
                set path2 [string range $path2 0 [expr $lastIndex2 -1]]
                set lastIndex2 [string last "/" $path2]
                if {$lastIndex2 == -1} {
                    break;
                }
            }
           set path [format "%s/.../%s" $path2 $fname]

        } else {
            # DOS type path

            set lastIndex [string last "\\" $path]
            set path2 [string range $path 0 [expr $lastIndex - 1]]
            set fname [string range $path [expr $lastIndex + 1] $totLen]
            set lastIndex2 [string last "\\" $path2]
            while {[expr [string length path2] + [string length $fname] + 5] \
                >= 50} {
                set path2 [string range $path2 0 [expr $lastIndex2 -1]]
                set lastIndex2 [string last "\\" $path2]
                if {$lastIndex2 == -1} {
                    break;
                }
            }
            set $path [format "%s\\...\\%s" $path2 $fname]

        }
    }
    return $path
}

#############################################################################
#
# fspace - returns free space available on Unix hosts
#
# This procedure returns the amount of free space avaiable on the given drive.
#
# SYNOPSIS:
# fspace dir
#
# PARAMETERS:
# <dir>
# a directory path.
#
# RETURNS: the number of free space in kilobytes avaiable
#
# ERRORS: N/A
#

proc fspace {dir} {

    if {![file isdirectory $dir]} {
        return "$dir: bad directory name"
    }

    # get the directory name in extension

    set here [pwd]
    cd $dir
    set dir [pwd]

    set free "unknown"

    switch [windHostTypeGet] {
        sun4-solaris2 -
        x86-linux2 {
            if {![catch {exec /bin/df -k $dir} result]} {
                set free [lindex $result 10]
            } else {
                set free [lindex $result 10]
            }
        }
        parisc-hpux10 {
            set found 0
            set ix 0
            while {$found == 0} {
                incr ix
                if {$ix > 30} {
                    break
                }
                if {[catch "exec /bin/df $dir" res]} {
                    # go backward one step looking for actual mounting
                    # point or device name alias
                    set dir [file dirname $dir]
                } else {
                    set freeSize [lindex [exec /bin/df -k $dir | /bin/sed -e "/total/d" -e "/used/d" ] 0]
                    if {[regexp {[^0-9]+} $freeSize] == 0} {
                        set free $freeSize
                    }
                    set found 1
                }
            }
        }
        default {}
    }
    cd $here
    return $free
}

##############################################################################
#
# debug - turns on debug mode
#
# SYNOPSIS
# debug
#
# PARAMETERS: N/A
#
# RETURNS: true if the environment var SETUP_DEBUG exists, otherwise false
#
# ERRORS: N/A
#

proc debug {} {
    global env
    global setupVals

    if {[info exists env(SETUP_DEBUG)]} {
        return 1
    } else {
        return 0
    }
}

##############################################################################
#
# openSetupDebugLog - open the setup log file
#
# SYNOPSIS
# openSetupDeubgLog
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc openSetupDebugLog {} {
    global env setupVals

    if {[info exists env(SETUP_DEBUG)] && $env(SETUP_DEBUG) != 0} {
        if {[info exists env(SETUP_DBGLOGFILE)]} {
            if {![info exists setupVals(DBGLOG_FD)]} {
                if {[catch {open $env(SETUP_DBGLOGFILE) "w"} setupVals(DBGLOG_FD)]} {
                    puts "Can't open $env(SETUP_DBGLOGFILE)"
                }
            }
        }
    }
    if {[info exists env(INF_DEBUG)] &&  $env(INF_DEBUG) != 0} {
        if {[info exists env(SETUP_DBGLOGFILE)]} {
            if {![info exists setupVals(DBGLOG_FD)]} {
                if {[catch {open $env(SETUP_DBGLOGFILE) "w"} setupVals(DBGLOG_FD)]} {
                    puts "Can't open $env(SETUP_DBGLOGFILE)"
                }
            }
        }
    }
}

##############################################################################
#
# closeSetupDebugLog - close the setup log file
#
# SYNOPSIS
# closeSetupLog
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc closeSetupDebugLog {} {
    global env
    global setupVals

    if {[info exists setupVals(DBGLOG_FD)]} {
        catch {close $setupVals(DBGLOG_FD)}
    }
}

#############################################################################
#
# dbgputs - wrapper for debug puts function.
#
# Wrapper for the puts function.  Only prints out the specified string
# either to the setup debug log file in env(SETUP_DBGLOGFILE) or the console,
# if the environment variable SETUP_DEBUG exists and is set to a nonzero value.
#
# SYNOPSIS
# dbgputs <line>
#
# PARAMETERS:
#   line : string to output.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc dbgputs {line} {
    global env
    global setupVals

    if {[info exists env(SETUP_DEBUG)]} {
        if {$env(SETUP_DEBUG) != 0 && [info exists setupVals(DBGLOG_FD)]} {
            puts $setupVals(DBGLOG_FD) $line
            flush $setupVals(DBGLOG_FD)
        } else {
            puts $line
        }
    }
}

#############################################################################
#
# fileContentGet - return the content of a file as a string
#
# This procedure opens a file and return the content of the file as a
# string separated by new lines
#
# SYNOPSIS
# .tS
# fileContentGet <file>
# .tE
#
# PARAMETERS:
# .IP file
# file name relative to the root of the CD
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc fileContentGet {file} {

    set file [cdFileNameGet $file]

    if {[file exists $file] == 0} {
        puts "Error: $file does not exists."
        return
    }

    if [catch {open $file r} infile] {
        puts "Error: can't open $file"
        return
    }

    set contents ""
    foreach line  [split [read $infile] \n] {
        string trimright $line
        append contents [format "%s\r\n" $line]
    }
    close $infile

    return $contents
}


proc licFileGet {} {
    global setupVals

    if {[info exists setupVals(licFile)]} {
        return $setupVals(licFile)
    } else {
        return ""
    }
}

proc licFileSet {licFile} {
    global setupVals

    set setupVals(licFile) $licFile

}


##############################################################################
#
# authCodeGet - returns the Authorization Code.
#
# This routine returns the user authorization code to access WRS database
#
# SYNOPSIS:
# authCodeGet
#
# PARAMETERS: N/A
#
# RETURNS: the Authorization Code if it exists, else an empty string.
#
# ERRORS: N/A
#

proc authCodeGet {} {
    global setupVals

    if {[info exists setupVals(authCode)]} {
        return $setupVals(authCode)
    } else {
        return ""
    }
}

##############################################################################
#
# authCodeSet - sets the Authorization Code
#
# Sets the global variable setupVals(authCode) to the authorization code
#
# SYNOPSIS:
# authCodeSet val
#
# PARAMETERS:
# <val>
# Contains the authorization code
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc authCodeSet {val} {
    global setupVals

    set setupVals(authCode) $val
}


##############################################################################
#
# tornadoProductCheck - checks if product name is a Tornado object.
#
# Returns whether the specified product is a Tornado object.  First the name
# of the product is checked that it begins with the word "tornado."  If so,
# it is then compared against the list of product names that are NOT tornado
# objects, such as tornado-bsp.  As a final check, the product description
# is checked to make sure it begins with the description "Tornado."
#
# SYNOPSIS:
# tornadoProductCheck productName productDesc
#
# PARAMETERS:
# <productName>
# Name of the product.
#
# <productDesc>
# Description of the product.
#
# RETURNS: 1 if product is a Tornado object, 0 otherwise.
#
# ERRORS: N/A
#

proc tornadoProductCheck {productName productDesc} {
    if {$productName == "tornado"} {
        return 1
    }
        
    if {[regexp {^tornado(-)?(.+)?} $productName match dash type]} {
                
        # Edit the following list to modify the product names that are
                # not Tornado objects.  For example, tornado-bsp* and
                # tornado-comp* are not Tornado objects.  ^ means
                # "string begins with" in tcl.
                
        switch -regexp $type {
                        ^core.* -
                        ^bsp.* -
                        ^comp.* -
                        ^src.* {
                return 0
                        }
                        default {
                                # make sure also that the product description begins
                                # with "Tornado."
                                
                                if {[regexp {^Tornado.*} $productDesc match]} {
                                        return 1
                                } else {
                    return 0
                                }
                        }
                }
    } else {
        return 0
    }
}

##############################################################################
#
# licensedProductCheck - checks if product name is a licensed product.
#