dbquery.tcl

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

            -controls [list \
                [list bitmap -name bmp -stretch \
                             -title [cdFileNameGet [file join RESOURCE \
                                BITMAPS SETUPICO.BMP]] \
                             -x 10 -y 5 -w 20 -h 20] \
                [list label -name "message1" -center \
                            -title [strTableGet DBQUERY_LICINFO_BANNER] \
                            -x 35 -y 10 -w 200 -h 10 ] \
                [list button -name cancel -title "&Cancel" \
                             -callback onCancel \
                             -x 100 -y 23 -w 50 -h 15] ]
    }
}

#############################################################################
#
# licInfoGetAllCallBack
#     GUI mode : a call back function for licInfoGetAllDlg
#     TEXT mode: retrieves license information from WRS database
#
# This function retrieves customer license information from WRS database. It 
# parses the license file, populates some lmVals values and calls 
# lmValsPopulate to fill the rest of lmVals values
#
# SYNOPSIS
# .tS
# licInfoGetAllCallBack
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc licInfoGetAllCallBack {} {
    global setupVals lmVals lmTotalRecs 
    global lmHostRecsLen lmHostRecs lmHostFeaturesNum
    global licInfoRetVal lmPurchasedProds lmPackages

    set licInfo ""
    set lmPackages {}

    if { [isGUImode] } {
        windowTimerCallbackSet licInfoGetAllDlg 0 ""
    } else {
        puts "\n[strTableGet DBQUERY_LICINFO_BANNER]"
    }

    # get license information here
        # send the licInfoGetAllRequest = 5 (ALI2.0)
        # send WRSLicense and Tornado version
        #
        set licInfoGetAllRequest 5
        set parms "$setupVals(WRSLicense)|$setupVals(prodVer)"

    set licInfo [sendToALD $licInfoGetAllRequest $parms]

    if {[isNumeric $licInfo]} {
        # error handling code here ...

        if {$licInfo == 0 || $licInfo == 1} {
            set licInfoRetVal $licInfo
           
            if { [isGUImode] } { windowClose licInfoGetAllDlg }

            return
        }
    }

    # parse the input into lmVals

    set licInfo [split $licInfo '\n']
    set listLen [llength $licInfo]
    if {[lindex $licInfo [expr $listLen - 1]] == ""} {
        set licInfo [lreplace $licInfo [expr $listLen - 1] [expr $listLen - 1]]
        set listLen [expr $listLen - 1]
    }

    # get the token
    set lmVals(token) [lindex $licInfo 0]

    # get the WRSLicense/projectName field
    set custLicProjName [split [lindex $licInfo 1] "|"]
    set lmVals(WRSLicense) [lindex $custLicProjName 0]
    set lmVals(projName) [lindex $custLicProjName 1]

    # get lmFeaturesTotal info (3rd line)
    set lmTotalRecs [split [lindex $licInfo 2] "|"]
    set lmVals(lmFeaturesTotal) ""

    # populate lmVals(lmFeaturesTotal)
    foreach feature $lmTotalRecs {
        set prod [split $feature ":"]
        set fName [lindex $prod 0]
        set fID [lindex $prod 1]

        # if any feature id is negative then this is an ELM user.

        if {$fID < 0} {
            dbgputs "dbQuery: ELM feature id found: $fID"
            set setupVals(ELMUser) 1
        } 	    		
	
        set fFLTotal [FLSeatsGet $feature]
        set fNLTotal [NLSeatsGet $feature]
        set fTotal [expr $fFLTotal + $fNLTotal]

        set lmVals(lmFeaturesTotal) \
            [lappend lmVals(lmFeaturesTotal) [list $fName $fTotal]]
        set lmVals(lmFLFeaturesTotal) \
            [lappend lmVals(lmFLFeaturesTotal) [list $fName $fFLTotal]]
        set lmVals(lmNLFeaturesTotal) \
            [lappend lmVals(lmNLFeaturesTotal) [list $fName $fNLTotal]]
    }

    # parse the hostRecords, they are of the form:
    # host|hostID|port|feature:featureId:FL-nn:NL-mm|...
    # Stop when we reach a line starting with %, then get the packages
    # and the purchased product records if any

    set packagesIndex [lsearch $licInfo "% Packages"]
    if {$packagesIndex != -1} {
        set lmHostRecs [lrange $licInfo 3 [expr $packagesIndex - 1]]
        set purchasedProdIndex [lsearch $licInfo "% PurchasedProducts"]
        set lmPackages [lrange $licInfo [expr $packagesIndex + 1] \
	   [expr $purchasedProdIndex -1]]
    } else {
        set purchasedProdIndex [lsearch $licInfo "% PurchasedProducts"]
        set lmHostRecs [lrange $licInfo 3 [expr $purchasedProdIndex - 1]]
    }
    set lmPurchasedProds [lrange $licInfo [expr $purchasedProdIndex + 1] $listLen]
    set lmHostRecsLen [llength $lmHostRecs]
    
    set lmHostFeaturesNum {}
    set nextRecIndex 0

    for {set ix 0} {$ix < $lmHostRecsLen} {incr ix} {
        set hostRec [split [lindex $lmHostRecs $ix] "|"]

        # get host information

        lappend lmVals(lmHosts) [lindex $hostRec 0]
        lappend lmVals(lmHostIds) [lindex $hostRec 1]
        lappend lmVals(lmHostPorts) [lindex $hostRec 2]  

        # get the number of features configured for that host

        set hostRecLen [llength $hostRec]
        lappend lmHostFeaturesNum [expr $hostRecLen - 3]
    }

    # Populate lmVals from the return record

    lmValsPopulate $lmVals(lmHostName)
    dbgputs "lmPurchasedProds: $lmPurchasedProds\n\n"
    dbgputs "lmPackages: $lmPackages\n\n"

    set licInfoRetVal ""

    if { [isGUImode] } { 
        windowClose licInfoGetAllDlg 
    } else {
        return 0
    }
}

#############################################################################
#
# onGrant - callback function when the grant option is selected
#
# This procedure is a callback which sets up wizard pages when the grant 
# option is selected
#
# SYNOPSIS
# .tS
# onGrant
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc onGrant {} {
    global setupVals 

    set setupVals(dbQueryOptions) "onGrant"
    
}

#############################################################################
#
# onDenied - callback function when the denied option is selected
#
# This procedure is a callback which sets up wizard pages when the denied 
# option is selected
#
# SYNOPSIS
# .tS
# onDenied
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#  
# ERRORS: N/A
#

proc onDenied {} {
    global setupVals 

    set setupVals(dbQueryOptions) "onDenied"
    
}


proc onSerial {} {
    global ctrlVals setupVals lmVals
    
    set w $ctrlVals(mainWindow) 
    
    
    if {[controlChecked $w.vsnChkBox]} {                                                 
        set id [hostIdGen vsn]
        set idType "(Disk Serial)"
    } else {
        set id [hostIdGen]
        set idType "(MAC)"
    }
    
    set setupVals(hostId) $id
    set lmVals(lmHostId) $id 
    
    set msg "Host ID $idType: $setupVals(hostId)"
       
    controlValuesSet $w.idInfo $msg
}

proc onVsnDetails {} {
    dialog ok_with_title \
        "Disk Serial Information" \
        [strTableGet DBQUERY_VSN_DETAILS]
}


#############################################################################
#
# onCancel - callback function when user clicks cancel while retrieving information
#
# This procedure is a callback when user clicks cancel button while retrieving
# license information from the database
#
# SYNOPSIS
# .tS
# onGrant
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc onCancel {} {
    global cancelDBQUERY
    global lmVals

    if {$lmVals(httpToken) != ""} {
        http_reset $lmVals(httpToken)
        set lmVals(httpToken) ""
    }
    controlEnable wizardDialog.backButt 0
    controlEnable wizardDialog.nextButt 0
    controlEnable wizardDialog.cancelButt 0
    controlEnable wizardDialog.helpButt 0
    windowClose licInfoGetAllDlg
    set cancelDBQUERY 1
}


#############################################################################
#
# lmValsInit - routine to clean out values that are volatile
#
# SYNOPSIS
# .tS
# lmValsInit
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc lmValsInit {} {
    global lmVals

    # clean out values that lmValsPopulate will add 
    
    set lmVals(lmHostIds) {}
    set lmVals(lmHostPorts) {}
    set lmVals(lmLicensedProductNames) {}
    set lmVals(lmLicensedFeatureIds) {}
    set lmVals(lmFeaturesAllocated) {}
    set lmVals(lmFeaturesAvailable) {}
    set lmVals(lmFeaturesRequested) {}

    # new lmVals for ALI 2.0
    set lmVals(lmFLFeaturesAllocated) {}
    set lmVals(lmNLFeaturesAllocated) {}
    set lmVals(lmFLFeaturesAvailable) {}
    set lmVals(lmNLFeaturesAvailable) {}
    set lmVals(lmFLFeaturesRequested) {}
    set lmVals(lmNLFeaturesRequested) {}

}


#############################################################################
#
# lmLicHostIndexGet - gets index to lmHostRecs for hostName
#
# This procedure gets the index in lmHostRecs list for the hostName parameter
#
# SYNOPSIS
# .tS
# lmLicHostInfoGet <attribute> index
#              
# .tE
#
# PARAMETERS: hostName
#
# RETURNS: index
#
# ERRORS: N/A
#

proc lmLicHostIndexGet {hostName} {
    global lmVals       

    set retVal -1
    for {set ix 0} {$ix < [llength $lmVals(lmHosts)]} {incr ix} {
        if {$hostName == [lindex $lmVals(lmHosts) $ix]} {
            set retVal $ix
            break
        }
    }
    return $retVal
}

#############################################################################
#
# lmLicHostInfoGet - gets attributes from lmHostRecs for host related items
#
# This procedure gets attributes from lmHostRecs list for licensed host items
# based on the index value parameter
#
# SYNOPSIS
# .tS
# lmLicHostInfoGet <attribute> index
#              
# .tE
#
# PARAMETERS: attribute index
# where attribute can be one of:
#       hostName        returns the host name corresponding to index
#       hostId          returns the host Id corresponding to index
#       hostPort        returns the host port corresponding to index
# and index is the index into the list
#
# RETURNS: see above
#
# ERRORS: N/A
#

proc lmLicHostInfoGet {attrib index} {
    global lmVals lmHostRecs lmHostRecsLen

    if {$index < 0} {
        puts "Error: index $index invalid"
        return ""
    }

    switch -exact $attrib {
        hostName {
            set rec [lindex $lmHostRecs $index]
            return [parseBarIndex $rec 0]
        }

        hostId {
            set rec [lindex $lmHostRecs $index]
            return [parseBarIndex $rec 1]
        }

        hostPort {
            set rec [lindex $lmHostRecs $index]
            return [parseBarIndex $rec 2]
        }
        
        default {
            puts "Error: no such attribute $attrib in lmHostRecs"
            return ""
        }
    }
}