home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # Copyright (c) 1997 by Cayenne Software, Inc.
- #
- # This software is furnished under a license and may be used only in
- # accordance with the terms of such license and with the inclusion of
- # the above copyright notice. This software or any other copies thereof
- # may not be provided or otherwise made available to any other person.
- # No title to and ownership of the software is hereby transferred.
- #
- # The information in this software is subject to change without notice
- # and should not be construed as a commitment by Cayenne Software, Inc.
- #
- #---------------------------------------------------------------------------
- #
- # File : chkcom.tcl
- # Author :
- # Original date : November 1997
- # Description : Classes for code generation
- #
- #---------------------------------------------------------------------------
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodconn.tcl /main/titanic/2
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodConn : {SMConnector} {
- method destructor
- constructor
- method isInSystem
- method isInFiles
- method isQualified
- method getCadName
- method getCodName
- method setCodConnInfo
- method mcheck
- attribute info
- }
-
- method CMCodConn::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- constructor CMCodConn {class this inModel} {
- set this [SMConnector::constructor $class $this $inModel]
- return $this
- }
-
- method CMCodConn::isInSystem {this {sys ""}} {
- # if not supplied, use current system for 'sys'
- #
- if {$sys == ""} {
- set sys [[[ClientContext::global] currentSystem] system]
- }
- set defSysV [$this getDefiningSystemVersion]
- if {![$defSysV isNil]} {
- if {[$defSysV system] == $sys} {
- return 1
- }
- }
- foreach comp [$this getComponents] {
- if {[$comp system] == $sys} {
- return 1
- }
- }
- return 0
- }
-
- method CMCodConn::isInFiles {this fileNames} {
- # note: 'fileNames' is an OOList
- set fileName ""
- foreach comp [$this getComponents] {
- set fileName [[[$comp diagram] file] qualifiedName]
- break
- }
- if {$fileName == ""} {
- return 0
- }
- return [expr {[$fileNames search -exact $fileName] != -1}]
- }
-
- method CMCodConn::isQualified {this} {
- return [regexp "^q" [$this getKind]]
- }
-
- method CMCodConn::getCadName {this} {
- switch [$this getKind] {
- assoc { return Association }
- aggr { return Aggregation }
- qassoc { return "Qualified Association" }
- default { return "Qualified Aggregation" }
- }
- }
-
- method CMCodConn::getCodName {this} {
- switch [$this getKind] {
- assoc { return Link }
- aggr { return "Aggregation Link" }
- qassoc { return "Qualified Link" }
- default { return "Qualified Aggregation Link" }
- }
- }
-
- method CMCodConn::setCodConnInfo {this} {
- $this info [CMCodInfo new]
-
- foreach propName {link_start_stereotype link_end_stereotype} {
- set propValue [$this getPropertyValue $propName]
- if {$propValue != "" && $propValue != "association"} {
- return
- }
- }
-
- set name [$this getItem]
- if {![$name isNil]} {
- [$this info] name [$name name]
- }
- set fromRole [$this getItem 0 "role_start" de]
- if {![$fromRole isNil]} {
- [$this info] fromRole [$fromRole name]
- }
- set toRole [$this getItem 0 "role_end" de]
- if {![$toRole isNil]} {
- [$this info] toRole [$toRole name]
- }
- set from [[$this getFrom] getItem 0 "" cl]
- if {![$from isNil]} {
- [$this info] from [$from name]
- }
- set to [[$this getTo] getItem 0 "" cl]
- if {![$to isNil]} {
- [$this info] to [$to name]
- }
- set qualifier [$this getPropertyValue "qual_value"]
- regsub -all "\t\n\r " $qualifier "" qualifier
- [$this info] qualifier $qualifier
- }
-
- method CMCodConn::mcheck {this} {
- $this setCodConnInfo
- set link [$this info]
- if {[$link from] == "" || [$link to] == ""} {
- return
- }
-
- [[$this getModel] getCadConnInfos [$this getKind]] foreach assoc {
- if {[$assoc from] == "" || [$assoc to] == ""} {
- continue
- }
- if {[$assoc from] == [$link from]} {
- if {[$assoc to] == [$link to] &&
- ([$link name] == "" || [$assoc name] == [$link name]) &&
- [$assoc fromRole] == [$link fromRole] &&
- [$assoc toRole] == [$link toRole] &&
- [$assoc qualifier] == [$link qualifier]} \
- {
- return
- }
- } elseif {[$assoc from] == [$link to]} {
- if {[$assoc to] == [$link from] &&
- ([$link name] == "" || [$assoc name] == [$link name]) &&
- [$assoc fromRole] == [$link toRole] &&
- [$assoc toRole] == [$link fromRole] &&
- [$assoc qualifier] == [$link qualifier]} \
- {
- return
- }
- }
- }
-
- set fileName "???:???"
- foreach comp [$this getComponents] {
- set fileName [[[$comp diagram] file] qualifiedName ":"]
- break
- }
- m4_error $E_LINK_NO_ASSOC [$this getCadName] [$this getCodName] [$link asString [$this isQualified]] $fileName.cod
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodinfo.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodInfo : {GCObject} {
- constructor
- method destructor
- method print
- method asString
- attribute name
- attribute from
- attribute to
- attribute fromRole
- attribute toRole
- attribute qualifier
- }
-
- constructor CMCodInfo {class this} {
- set this [GCObject::constructor $class $this]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method CMCodInfo::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- method CMCodInfo::print {this {fd stderr}} {
- puts $fd " @@ |[$this from]|\[[$this qualifier]\]-[$this fromRole]---[$this name]---[$this toRole]-|[$this to]|"
- }
-
- method CMCodInfo::asString {this {isQualified 1}} {
- set str ""
- if {[$this name] != ""} {
- set str "'[$this name]' "
- }
- set str "${str}between Instance of type '[$this from]' and Instance of type '[$this to]'"
- set sep " having "
- if {[$this fromRole] != ""} {
- set str "${str}${sep}start role '[$this fromRole]'"
- set sep ", "
- }
- if {[$this toRole] != ""} {
- set str "${str}${sep}end role '[$this toRole]'"
- set sep " and "
- }
- if {$isQualified} {
- if {$sep == ", "} { set sep " and " }
- set str "${str}${sep}qualifier '[$this qualifier]'"
- }
- return $str
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodmodel.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodModel : {SMPhaseModel} {
- method destructor
- constructor
- method defineSMTypes
- method makeSMTypeName
- method getCadConnInfos
- method mcheck
- method addAssoc
- method removeAssoc
- method addAggr
- method removeAggr
- method addQassoc
- method removeQassoc
- method addQaggr
- method removeQaggr
- attribute assocSet
- attribute aggrSet
- attribute qassocSet
- attribute qaggrSet
- }
-
- method CMCodModel::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- constructor CMCodModel {class this configV phaseV} {
- set this [SMPhaseModel::constructor $class $this $configV $phaseV]
-
- # Define global available SMTypes
- $this defineSMTypes
-
- # Add creator scripts to the ObjectFactory
- set objFac [$this getObjectFactory]
- #
- $objFac addCreatorScript $OMT_COD_Link "
- return \[CMCodLinkConn new $this]
- "
- $objFac addCreatorScript $OMT_COD_AggrLink "
- return \[CMCodAggrLinkConn new $this]
- "
- $objFac addCreatorScript $OMT_COD_QualifLink "
- return \[CMCodQLinkConn new $this]
- "
- $objFac addCreatorScript $OMT_COD_QualifAggrLink "
- return \[CMCodQAggrLinkConn new $this]
- "
- $objFac addCreatorScript $OMT_COD_NaryLink "
- return \[CMCodNAryLink new $this]
- "
-
- return $this
- }
-
- method CMCodModel::defineSMTypes {this} {
- set typeIter [SMTypeIter new]
- while {[$typeIter current] != ""} {
- set smType [$typeIter current]
- if {!([string match CAD* [$smType name]] || [string match COD* [$smType name]])} {
- $typeIter next
- continue
- }
- set name [$this makeSMTypeName [$smType name]]
- eval "global $name"
- eval "set $name $smType"
- $typeIter next
- }
- $typeIter delete
-
- global ANY; set ANY [SMTypeDB::any]
- }
-
- method CMCodModel::makeSMTypeName {this type} {
- regsub -all "\[ \t]+" $type "_" type
- return "OMT_$type"
- }
-
- method CMCodModel::getCadConnInfos {this kind} {
- set lst ${kind}Set
- if {[$this $lst] != ""} {
- return [$this $lst]
- }
-
- switch $kind {
- assoc { set type $OMT_CAD_Association }
- aggr { set type $OMT_CAD_Aggregation }
- qassoc { set type $OMT_CAD_QualAssoc }
- default { set type $OMT_CAD_QualAggr }
- }
- $this $lst [List new]
- foreach conn [$this getSMObjects $type] {
- set info [CMCodInfo new]
-
- set name [$conn getItem]
- if {![$name isNil]} {
- $info name [$name name]
- }
- set fromRole [$conn getItem 0 "role_start" de]
- if {![$fromRole isNil]} {
- $info fromRole [$fromRole name]
- }
- set toRole [$conn getItem 0 "role_end" de]
- if {![$toRole isNil]} {
- $info toRole [$toRole name]
- }
- set qualifier [$conn getItem 0 "qualifier" de]
- if {![$qualifier isNil]} {
- $info qualifier [$qualifier name]
- }
- set from [[$conn getFrom] getItem 0 "" cl]
- if {![$from isNil]} {
- $info from [$from name]
- }
- set to [[$conn getTo] getItem 0 "" cl]
- if {![$to isNil]} {
- $info to [$to name]
- }
-
- [$this $lst] append $info
- }
- return [$this $lst]
- }
-
- method CMCodModel::mcheck {this {codNames {}}} {
- # check all Links in *current* system, and optionally in files with
- # names in 'codNames'
- #
- if {$codNames != {}} {
- set codNameList [List new]
- $codNameList contents $codNames
- }
-
- set links {}
- foreach type "
- $OMT_COD_Link
- $OMT_COD_AggrLink
- $OMT_COD_QualifLink
- $OMT_COD_QualifAggrLink
- " {
- foreach obj [$this getSMObjects $type] {
- if {[[[$obj getTo] getSemType] name] == "Class" && [[[$obj getFrom] getSemType] name] == "Class"} {
- lappend links $obj
- }
- }
- }
- # IMPR: $OMT_COD_NaryLink
-
- foreach link $links {
- if {$link == ""} continue
- if {[$link isInSystem] && ($codNames == {} || [$link isInFiles $codNameList])} {
- $link mcheck
- }
- }
- }
-
- # Do not delete this line -- regeneration end marker
-
- method CMCodModel::addAssoc {this newAssoc} {
- [$this assocSet] append $newAssoc
-
- }
-
- method CMCodModel::removeAssoc {this oldAssoc} {
- [$this assocSet] removeValue $oldAssoc
- }
-
- method CMCodModel::addAggr {this newAggr} {
- [$this aggrSet] append $newAggr
-
- }
-
- method CMCodModel::removeAggr {this oldAggr} {
- [$this aggrSet] removeValue $oldAggr
- }
-
- method CMCodModel::addQassoc {this newQassoc} {
- [$this qassocSet] append $newQassoc
-
- }
-
- method CMCodModel::removeQassoc {this oldQassoc} {
- [$this qassocSet] removeValue $oldQassoc
- }
-
- method CMCodModel::addQaggr {this newQaggr} {
- [$this qaggrSet] append $newQaggr
-
- }
-
- method CMCodModel::removeQaggr {this oldQaggr} {
- [$this qaggrSet] removeValue $oldQaggr
- }
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodnaryl.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodNAryLink : {SMNode} {
- method destructor
- constructor
- method isInSystem
- method mcheck
- }
-
- method CMCodNAryLink::destructor {this} {
- # Start destructor user section
- # End destructor user section
- }
-
- constructor CMCodNAryLink {class this inModel} {
- set this [SMNode::constructor $class $this $inModel]
- return $this
- }
-
- method CMCodNAryLink::isInSystem {this {sys ""}} {
- # if not supplied, use current system for 'sys'
- #
- if {$sys == ""} {
- set sys [[[ClientContext::global] currentSystem] system]
- }
- set defSysV [$this getDefiningSystemVersion]
- if {![$defSysV isNil]} {
- if {[$defSysV system] == $sys} {
- return 1
- }
- }
- foreach comp [$this getComponents] {
- if {[$comp system] == $sys} {
- return 1
- }
- }
- return 0
- }
-
- method CMCodNAryLink::mcheck {this} {
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodlinkc.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodLinkConn : {CMCodConn} {
- method destructor
- constructor
- method getKind
- }
-
- method CMCodLinkConn::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this CMCodConn::destructor
- }
-
- constructor CMCodLinkConn {class this inModel} {
- set this [CMCodConn::constructor $class $this $inModel]
- return $this
- }
-
- method CMCodLinkConn::getKind {this} {
- return assoc
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodqlink.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodQLinkConn : {CMCodLinkConn} {
- method destructor
- constructor
- method getKind
- }
-
- method CMCodQLinkConn::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this CMCodLinkConn::destructor
- }
-
- constructor CMCodQLinkConn {class this inModel} {
- set this [CMCodLinkConn::constructor $class $this $inModel]
- return $this
- }
-
- method CMCodQLinkConn::getKind {this} {
- return qassoc
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodaggrl.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodAggrLinkConn : {CMCodConn} {
- method destructor
- constructor
- method getKind
- }
-
- method CMCodAggrLinkConn::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this CMCodConn::destructor
- }
-
- constructor CMCodAggrLinkConn {class this inModel} {
- set this [CMCodConn::constructor $class $this $inModel]
- return $this
- }
-
- method CMCodAggrLinkConn::getKind {this} {
- return aggr
- }
-
- # Do not delete this line -- regeneration end marker
-
- #---------------------------------------------------------------------------
- # File: @(#)cmcodqaggr.tcl /main/titanic/1
- #---------------------------------------------------------------------------
-
- # Start user added include file section
- # End user added include file section
-
-
- Class CMCodQAggrLinkConn : {CMCodAggrLinkConn} {
- method destructor
- constructor
- method getKind
- }
-
- method CMCodQAggrLinkConn::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this CMCodAggrLinkConn::destructor
- }
-
- constructor CMCodQAggrLinkConn {class this inModel} {
- set this [CMCodAggrLinkConn::constructor $class $this $inModel]
- return $this
- }
-
- method CMCodQAggrLinkConn::getKind {this} {
- return qaggr
- }
-
- # Do not delete this line -- regeneration end marker
-
-