📄 global.tcl
字号:
# 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.
#
# This procedure checks if a product is a licensed product, given a
# featureId. A licensed product has a non-zero featureId.
#
# SYNOPSIS:
# licensedProductCheck featureID
#
# PARAMETERS:
# <featureID>
# Feature ID of the product
#
# RETURNS: 1 if product is a licensed product, 0 otherwise.
#
# ERRORS: N/A
#
proc licensedProductCheck {featureID} {
if { $featureID > 0 } {
return 1
} else {
return 0
}
}
##############################################################################
#
# hostIdGen - Generates the host Id
#
# This routine generates the host Id from flexlm lmhostid call. If there is
# no NIC card, it will proble for the Volume Serial Number (windows only)
#
# SYNOPSIS:
# hostIdGen
#
# PARAMETERS:
# For Windows use
# "vsn": Retrieve drive c: serial number (for Windows)
# For UNIX, no argument needed
#
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -