stafutil.tcl

Software Testing Automation Framework (STAF)的开发代码

#############################################################################
# Software Testing Automation Framework (STAF)                              #
# (C) Copyright IBM Corp. 2001                                              #
#                                                                           #
# This software is licensed under the Common Public License (CPL) V1.0.     #
#############################################################################

###################################################
# STAFUtil.tcl - STAF Utility TCL Library         #
###################################################

package provide STAF 3.0
package require TCLSTAF

namespace eval STAF {

    variable kOk                                 0
    variable kInvalidAPI                         1
    variable kUnknownService                     2
    variable kInvalidHandle                      3
    variable kHandleAlreadyExists                4
    variable kHandleDoesNotExist                 5
    variable kUnknownError                       6
    variable kInvalidRequestString               7
    variable kInvalidServiceResult               8
    variable kREXXError                          9
    variable kBaseOSError                       10
    variable kProcessAlreadyComplete            11
    variable kProcessNotComplete                12
    variable kVariableDoesNotExist              13
    variable kUnResolvableString                14
    variable kInvalidResolveString              15
    variable kNoPathToMachine                   16
    variable kFileOpenError                     17
    variable kFileReadError                     18
    variable kFileWriteError                    19
    variable kFileDeleteError                   20
    variable kSTAFNotRunning                    21
    variable kCommunicationError                22
    variable kTrusteeDoesNotExist               23
    variable kInvalidTrustLevel                 24
    variable kAccessDenied                      25
    variable kSTAFRegistrationError             26
    variable kServiceConfigurationError         27
    variable kQueueFull                         28
    variable kNoQueueElement                    29
    variable kNotifieeDoesNotExist              30
    variable kInvalidAPILevel                   31
    variable kServiceNotUnregisterable          32
    variable kServiceNotAvailable               33
    variable kSemaphoreDoesNotExist             34
    variable kNotSemaphoreOwner                 35
    variable kSemaphoreHasPendingRequests       36
    variable kTimeout                           37
    variable kJavaError                         38
    variable kConverterError                    39
    variable kInvalidObject                     41
    variable kInvalidParm                       42
    variable kRequestNumberNotFound             43
    variable kInvalidAsynchOption               44
    variable kRequestNotComplete                45
    variable kProcessAuthenticationDenied       46
    variable kInvalidValue                      47
    variable kDoesNotExist                      48
    variable kAlreadyExists                     49
    variable kDirectoryNotEmpty                 50
    variable kDirectoryCopyError                51
    variable kDiagnosticsNotEnabled             52
    variable kHandleAuthenticationDenied        53
    variable kHandleAlreadyAuthenticated        54
    variable kInvalidSTAFVersion                55
    variable kRequestCancelled                  56

}

################################################################
# STAF::WrapData - Wraps a TCL String using colon delimited    # 
#                  STAF format                                 # 
# Accepts: A string                                            #
# Returns: Colon-delimited version of input string             #
################################################################

proc STAF::WrapData {data} { 
  return :[string length $data]:$data
}


################################################################################
# STAF::internalCheckCommandInput - Used internally by STAF to ensure a caller #
#                                   has provided proper parameters to a proc   #
# optionDefs:                                                                  #
#   {                                                                          #
#     { optionName ?default value? } ...                                       #
#   }                                                                          #
#                                                                              #
# Note: If no default value is provided then the option is not allowed to      #
#       have a value                                                           #
#                                                                              #
# argDefs:                                                                     #
#   {                                                                          #
#     { argName ?default value? } ...                                          #
#     ?otherArgs?                                                              #
#   }                                                                          #
#                                                                              #
# Note: If no default value is provided then the argument must be present      #
# Note: If an argName of "otherArgs" is specified, then all remaining args     #
#       will be grouped with that argument                                     #
#                                                                              #
# Returns:                                                                     #
#   {                                                                          #
#     { returnCode ?error string if non-zero RC? }                             #
#     ?{ optionName optionValue ... }?  -- if RC == 0                          #
#     ?{ argName argValue ... }?        -- if RC == 0                          #
#   }                                                                          #
#                                                                              #
# Note: Only options actually specified by the user are returned               #
################################################################################

proc STAF::internalCheckCommandInput {commandInput optionDefs argDefs} {
    # Initialize error buffers

    set errorBuffer {wrong # args: should be "}
    set validOptions {valid options are}

    # Set up option definitions

    foreach optionDef $optionDefs {
        if {[llength $optionDef] == 2} {
            set options([lindex $optionDef 0]) "VALUEALLOWED"
            set outputOptions([lindex $optionDef 0]) [lindex $optionDef 1]
            set errorBuffer "$errorBuffer ?-[lindex $optionDef 0] ?value??"
            set validOptions "$validOptions -[lindex $optionDef 0]"
        } else {
            set options([lindex $optionDef 0]) "NOVALUEALLOWED"
            set errorBuffer "$errorBuffer ?-[lindex $optionDef 0]?"
            set validOptions "$validOptions -[lindex $optionDef 0]"
        }
    }

    # Set up argument definitions

    set numArgsDefined 0

    foreach argDef $argDefs {
        if {[llength $argDef] == 2} {
            set args($numArgsDefined) [list [lindex $argDef 0] \
                                            "OPTIONAL [lindex $argDef 1]"]
            set errorBuffer "$errorBuffer ?[lindex $argDef 0]?"
        } else {
            set args($numArgsDefined) [list [lindex $argDef 0] REQUIRED]
            set errorBuffer "$errorBuffer [lindex $argDef 0]"
        }

        incr numArgsDefined
    }

    # Get all options out of the input

    while {[string index [lindex $commandInput 0] 0] == "-"} {
        set currOption [string range [lindex $commandInput 0] 1 end]
        set currOptionValue {}
        set commandInput [lrange $commandInput 1 end]

        if {[info exists options($currOption)] == 0} {
            return [list [list 1 "bad option \"-$currOption\": $validOptions"]]
        } else {
            if {$options($currOption) == "NOVALUEALLOWED"} {
                set outputOptions($currOption) {}
            } elseif {[string index [lindex $commandInput 0] 0] != "-"} {
                set outputOptions($currOption) [lindex $commandInput 0]
                set commandInput [lrange $commandInput 1 end]
            }
        }
    }

    # Now process arguments

    set currArgNum 0

    while {$currArgNum != $numArgsDefined} {
        if {[lindex [lindex $args($currArgNum) 1] 0] == "REQUIRED"} {
            if {[llength $commandInput] == 0} {
                return [list [list 1 $errorBuffer] {} {}]
            }

            set outputArgs([lindex $args($currArgNum) 0]) \
                [lindex $commandInput 0]
            set commandInput [lrange $commandInput 1 end]
        } else {
            if {[llength $commandInput] != 0} {
                set outputArgs([lindex $args($currArgNum) 0]) \
                    [lindex $commandInput 0]
                set commandInput [lrange $commandInput 1 end]
            } else {
                set outputArgs([lindex $args($currArgNum) 0]) \
                    [lrange [lindex $args($currArgNum) 1] 1 end]
            }
        }

        incr currArgNum
    }

    return [list [list 0 "Ok"] [array get outputOptions] [array get outputArgs]]
}


namespace eval STAF {

    variable NoneType    "STAF_DT_NONE"
    variable ScalarType  "STAF_DT_SCALAR"
    variable ListType    "STAF_DT_LIST"
    variable MapType     "STAF_DT_MAP"
    variable ContextType "STAF_DT_CONTEXT"

    variable CompleteTypeList [list $NoneType $ScalarType $ListType $MapType $ContextType]
}


proc STAF::datatype {args} {
    if {[llength $args] == 0} {
        error {wrong # args: should be "STAF::datatype subcommand ?arg ...?"}
    }

    set subcommand [lindex $args 0]
    set args [lrange $args 1 end]

    switch $subcommand {
        createNone {
            set checkResult [STAF::internalCheckCommandInput $args {} {}]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            return [list $STAF::NoneType "None"]
        }

        createScalar {
            # args: [value]
            set myArgs [list {value {}}]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            return "$STAF::ScalarType $input(value)"
        }

        createList {
            # args: [value]
            set myArgs [list {value {}}]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            return "$STAF::ListType $input(value)"
        }

        createMap {
            # args: [value]
            set myArgs [list {value {}}]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            return "$STAF::MapType $input(value)"
        }

        createContext {
            # args: [value]
            set myArgs [list {value {}}]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            return "$STAF::ContextType $input(value)"
        }

        getType {
            # args: object
            set myArgs [list object]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            set type [lindex $input(object) 0]

            if {[lsearch -exact $STAF::CompleteTypeList $type] == -1} {
                return $STAF::ScalarType
            }

            return $type
        }

        getValue {
            # args: object
            set myArgs [list object]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            set objType [lindex $input(object) 0]

            if {[lsearch -exact $STAF::CompleteTypeList $objType] == -1} {
                return $input(object)
            }