PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/drslevelob.tcl

Text File | 1997-05-21 | 12.6 KB | 363 lines

#---------------------------------------------------------------------------
#
#      (c)     Cayenne Software Inc.    1997
#
#      File:           @(#)drslevelob.tcl    /main/hindenburg/22
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)drslevelob.tcl    /main/hindenburg/22   21 May 1997 Copyright 1997 Cayenne Software Inc.

# Start user added include file section
# End user added include file section

require "drstreeobj.tcl"

#Class DrsLevelObject : {DrsTreeObject} {
#    method destructor
#    constructor
#    method copyProperties
#    method createLevel
#    method deleteObject
#    method deleteLevel
#    method getDiagramType
#    method getConfigVersion
#    method getDoorsParObjId
#    method getLevelV
#    method install
#    method isAvailable
#    method isIntegrated
#    method lock
#    method removeReference
#    method removeRefObject
#    method saveReference
#    method updateObject
#    attribute levelId
#    attribute versionId
#    attribute levelVersions
#    attribute parentLevel
#    attribute parentLevelId
#    attribute configV
#}

method DrsLevelObject::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this DrsTreeObject::destructor
}

constructor DrsLevelObject {class this level levelVersion pLevel pVersion} {
    set this [DrsTreeObject::constructor $class $this $level]
        $this level $level
        $this versionId $levelVersion
        $this parentLevel $pLevel
        $this parentLevelId $pVersion
        return $this

}

method DrsLevelObject::copyProperties {this otObject doorsObject} {
    set dxlCommand [$this dxlCommand]
    foreach propName [m4_var get M4_doors_integrated_properties] {
        set propVal [$otObject getPropertyValue $propName]
        $dxlCommand doorsObjectAttrSetValue $doorsObject $propName $propVal
    }
    set objTextAttr [m4_var get M4_doors_objecttext_property]
    if [llength $objTextAttr] {
        set propVal [$otObject getPropertyValue [lindex $objTextAttr 0]]
        $dxlCommand doorsObjectAttrSetValue $doorsObject "Object Text" $propVal
    }
    set levelName  [[$this level] name]
    $dxlCommand doorsObjectAttrSetValue $doorsObject "Object Heading" $levelName
}

method DrsLevelObject::createLevel {this doorsObject} {
    set dxlCommand [$this dxlCommand]
    set levelName  [[$this level] name]
    set toFilterName  "[[$this level] name][[$this level] type]"
    regsub -all {\.|\:|\(|\)|\\|\||\[|\]|\*|\+|\#|\-|\!|\=} $toFilterName "" filteredName
    set newObject [$dxlCommand doorsObjectCreateChild $doorsObject \
                $levelName $filteredName]
    $dxlCommand doorsObjectAttrSave $newObject "Absolute Number"
    return $newObject
}

method DrsLevelObject::deleteObject {this} {
    # remove object from the list of selected objects of its parent
    set thisLevel [$this level]
    if [llength [$this getLevelV]] {
        return
    }
    [.main messageArea] message  "Removing [$this levelName] version [$this versionId]"
    set parVersDict [Dictionary new]
    $parVersDict contents [$thisLevel  getPropertyValue \
                            ${FORMALMODULE}_ParentOTVersions]
    set myParentVersions [$this versionId]
    set delInd [lsearch $myParentVersions  [$this parentLevelId ]]
    set newMyParentVersions [lreplace $myParentVersions $delInd $delInd]
    if [llength $newMyParentVersions] {
        $parVersDict set [$this versionId] $newParentVersions
    } else {
        $parVersDict unset [$this versionId]
    }
    set newParentVersions [$parVersDict contents]

    set parentLevel [$this getParentPropertyObject]
    if ![llength $parentLevel] {
        return
    }
    set parentChildDict [Dictionary new]
    set selectedItems [$parentLevel getPropertyValue \
                    ${FORMALMODULE}_SelectedItems]
    $parentChildDict contents $selectedItems
    set levelName [$this levelName]
    set versionsOfMyself [$parentChildDict set  $levelName]
    set currIndex [lsearch $versionsOfMyself [$this versionId]]
    set versionsOfMyself [lreplace $versionsOfMyself $currIndex $currIndex]
    # am I selected somewhere?
    if ![llength $versionsOfMyself] {
        $parentChildDict unset $levelName
    } else {
        $parentChildDict set $levelName $versionsOfMyself
    }
    set parChilds [$parentChildDict contents]
    set dxlCommand [$this newDxlCommand "edit"]
    set doorsObjId [$thisLevel getPropertyValue $FORMALMODULE]
    set parObjId [$parentLevel getPropertyValue $FORMALMODULE]
    set doorsObject [$dxlCommand doorsObjectFind $doorsObjId]
    $dxlCommand doorsObjectAttrSetValue $doorsObject \
                                ParentOTVersions $newParentVersions

    set doorsObject [$dxlCommand doorsObjectFind $parObjId]
    if {$selectedItems != $parChilds} {
        $dxlCommand doorsObjectAttrSetValue $doorsObject \
                                SelectedItems $parChilds
    }

    $dxlCommand doorsResultSave "1"
    $dxlCommand doorsResultSave projectName
    set dxlResult [$this sendDxlCommand]
    set resultListLength [llength $dxlResult]
    if $resultListLength  {
        set lastIndex [expr $resultListLength - 1]
        set projectName [lindex $dxlResult $lastIndex]
        set formalModuleName [m4_var get M4_doors_formal_module]
        set FORMALMODULE "DOORS_${projectName}_$formalModuleName"
        $this removeReference $thisLevel $newParentVersions $doorsObjId $parChilds
    }
}

method DrsLevelObject::deleteLevel {this otLevel parChilds} {
    set dxlCommand [$this dxlCommand]
    set doorsObjId [$otLevel getPropertyValue $FORMALMODULE]
    set doorsObject [$dxlCommand doorsObjectFind $doorsObjId]
    $dxlCommand doorsObjectDelete $doorsObject
}

method DrsLevelObject::getEditorTypes {this} {
    return ""
}

method DrsLevelObject::getConfigVersion {this} {
    set config [$this configV]
    if ![llength $config] {
        set cc [ClientContext::global]
        set config [$cc currentConfig]
        $this configV $config
    }
    return $config

}

method DrsLevelObject::getDoorsParObjId {this} {
    set dxlCommand [$this dxlCommand]
    set parLevel [$this getParentPropertyObject]
    set parDrsObjId [$parLevel getPropertyValue $FORMALMODULE]
    set doorsObject [$dxlCommand doorsObjectFind $parDrsObjId]
    return $doorsObject
}

method DrsLevelObject::getLevelV {this} {
    set thisLevel [$this level]
    set versionId [$this versionId]
    return [searchOnVersion [$this levelVersions] $versionId ]

}

method DrsLevelObject::install {this} {
    [.main messageArea] message  "Checking [$this levelName]"
    set thisLevel [$this getPropertyObject]
    set levelObjId [$thisLevel getPropertyValue $FORMALMODULE]

    # ParentOTVersion property is a dictionary with:
    # Key: The version of myself
    # List: The versions of the parent in which I am selected
    set childOfDict [Dictionary new]
    set thisIsIntegrated [$this isIntegrated  $levelObjId]
    if $thisIsIntegrated {
        # current name is integrated
        $childOfDict contents  [$thisLevel getPropertyValue \
                    ${FORMALMODULE}_ParentOTVersions]
        set parentList [$childOfDict set [$this versionId]]
        if  [$this isAvailable $parentList]  {
        # current name version is integrated
        set propObj [$this getPropertyObject]
        set storedUpdateTime [$propObj  getPropertyValue ${FORMALMODULE}_TIMESTAMP]
        set currentTimeStamp [[$this getTimeStampObject] updateTime]
        if {![llength $storedUpdateTime] || [expr $storedUpdateTime + 5 < $currentTimeStamp] || $currentTimeStamp < $storedUpdateTime} {
            # Update when
            # 1. Really out of date.
            # 2. Older version selected or in other configuration

            $this updateObject $levelObjId $currentTimeStamp
        }
        return "1"
        }
    }

    set parentLevel [$this getParentPropertyObject]
    lappend parentList [$this parentLevelId]
    $childOfDict set [$this versionId] $parentList
    set childOf [$childOfDict contents]

    # Extend the selected items property
    set parentChildDict [Dictionary new]
    $parentChildDict contents \
        [$parentLevel getPropertyValue ${FORMALMODULE}_SelectedItems]
    set versionsOfMyself [$parentChildDict set  [$this levelName]]
    lappend  versionsOfMyself [$this versionId]
    $parentChildDict set [$this levelName] $versionsOfMyself
    set selItems [$parentChildDict contents]

    # DXL stuff
    set dxlCommand [$this newDxlCommand "edit"]
    set doorsObject [$this DrsLevelObject::getDoorsParObjId]
    if ![llength $doorsObject] {
        return "1"
    }
    $dxlCommand doorsObjectAttrSetValue $doorsObject SelectedItems $selItems
    if [$this isA DrsGroupedObject] {
        set doorsObject [$this getDoorsParObjId]
    }
    if ![llength $doorsObject] {
        return "1"
    }
    set thisLevelV [$this getLevelV]
    if !$thisIsIntegrated {
        if ![$this lock] {
        global frozenFiles
        lappend frozenFiles $this
        return "1"
        }
        [.main messageArea] message  "Installing [$this levelName]"
        set newDoorsObject [$this createLevel $doorsObject]
        $dxlCommand doorsResultSave projectName
        set levelVObjId [$thisLevelV getPropertyValue $FORMALMODULE]
        if ![llength $levelVObjId] {
        # integrated property not available
        # may be linked via imp_from property
        set imp_from [$thisLevelV getPropertyValue imp_from]
        if [llength $imp_from] {
            # we are in the implementation phase
            # this is a file file version (ext file or link)
            set levelVObjId [$this getClassIdInPrevPhase $imp_from]
        }
        }
        if [llength $levelVObjId] {
        # LINK to previous phase
        $this linkToPrevPhase $levelVObjId $newDoorsObject
        }
    } else {
        [.main messageArea] message  "Adding [$this levelName] version"
        set newDoorsObject [$dxlCommand doorsObjectFind $levelObjId]
        $dxlCommand doorsResultSave $levelObjId
        $dxlCommand doorsResultSave projectName
    }
    if [$this isA DrsSMItemObject] {
        $this linkComponents $newDoorsObject
    }
    $dxlCommand doorsObjectAttrSetValue $newDoorsObject \
                                                ParentOTVersions $childOf
    $dxlCommand doorsObjectAttrSetValue $newDoorsObject OTType [$this levelType]
    $dxlCommand doorsObjectAttrSetValue $newDoorsObject OTEditorTypes [$this getEditorTypes]
    $this copyProperties $thisLevelV $newDoorsObject
    $dxlCommand doorsObjectSetCurrent $newDoorsObject

    set dxlResult [$this sendDxlCommand]
    set resultListLength [llength $dxlResult]
    if $resultListLength  {
        set lastIndex [expr $resultListLength - 1]
        set specIndex 0
        set ptr [lindex $dxlResult 0]
        while  {[llength $ptr] && [expr  [scan $ptr "%d%s" $ptr rest] == 1 ]} {
        #still isnum
        incr specIndex
        set ptr [lindex $dxlResult $specIndex]
        }
        set projectName [lrange $dxlResult $specIndex $lastIndex]
        set specIndex [expr $specIndex - 1]
        set dxlResult [lrange $dxlResult 0 $specIndex]
        set formalModuleName [m4_var get M4_doors_formal_module]
        global  FORMALMODULE
        set FORMALMODULE "DOORS_${projectName}_$formalModuleName"
        $this saveReference $thisLevel $dxlResult $childOf $selItems
    }
    return $dxlResult

}

method DrsLevelObject::isAvailable {this parentList} {
    #checks whether the object is already available in the list of versions
    if {[lsearch $parentList [$this parentLevelId]] != -1} {
        return 1
    }
    return 0
}

method DrsLevelObject::isIntegrated {this doorsObjId} {
    return [llength $doorsObjId]
}

method DrsLevelObject::lock {this} {
    return 1
}

method DrsLevelObject::removeReference {this otObject newPropValue doorsObjId parChilds} {
    set thisLevel [$this level]
    $thisLevel setProperty ${FORMALMODULE}_ParentOTVersions $newPropValue
    set parentLevel [$this getParentPropertyObject]
    $parentLevel setProperty ${FORMALMODULE}_SelectedItems $parChilds

}

method DrsLevelObject::removeRefObject {this otObject} {
    $otObject removeProperty $FORMALMODULE
    $otObject removeProperty ${FORMALMODULE}_ParentOTVersions
}

method DrsLevelObject::saveReference {this otObject doorsRef parOTVersions selItems} {
    $this DrsTreeObject::saveReference $otObject $doorsRef $selItems
    $otObject setProperty ${FORMALMODULE}_ParentOTVersions $parOTVersions
}

method DrsLevelObject::updateObject {this levelObjId currentTimeStamp} {
    [.main messageArea] message  "Updating [$this levelName] properties"
    set dxlCommand [$this newDxlCommand "edit"]
    set doorsObject [$dxlCommand doorsObjectFind $levelObjId]
    $dxlCommand doorsObjectSetCurrent $doorsObject
    $this copyProperties [$this getLevelV] $doorsObject
    if [$this isA DrsSMItemObject] {
        $this linkComponents $doorsObject
    }
    set dxlResult [$this sendDxlCommand]
    set propObj [$this getPropertyObject]
    $propObj setProperty ${FORMALMODULE}_TIMESTAMP $currentTimeStamp
    # now the updateTime has changed
    # second time for synchronization
    set timeStamp [[$this getTimeStampObject] updateTime]
    $propObj setProperty ${FORMALMODULE}_TIMESTAMP $timeStamp
}

# Do not delete this line -- regeneration end marker