home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / chkcom.tcl < prev    next >
Text File  |  1997-12-01  |  16KB  |  622 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1997 by Cayenne Software, Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cayenne Software, Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #       File            : chkcom.tcl
  17. #       Author          : 
  18. #       Original date   : November 1997
  19. #       Description     : Classes for code generation
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)cmcodconn.tcl    /main/titanic/2
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class CMCodConn : {SMConnector} {
  32.     method destructor
  33.     constructor
  34.     method isInSystem
  35.     method isInFiles
  36.     method isQualified
  37.     method getCadName
  38.     method getCodName
  39.     method setCodConnInfo
  40.     method mcheck
  41.     attribute info
  42. }
  43.  
  44. method CMCodConn::destructor {this} {
  45.     # Start destructor user section
  46.     # End destructor user section
  47. }
  48.  
  49. constructor CMCodConn {class this inModel} {
  50.     set this [SMConnector::constructor $class $this $inModel]
  51.     return $this
  52. }
  53.  
  54. method CMCodConn::isInSystem {this {sys ""}} {
  55.     # if not supplied, use current system for 'sys'
  56.     #
  57.     if {$sys == ""} {
  58.     set sys [[[ClientContext::global] currentSystem] system]
  59.     }
  60.     set defSysV [$this getDefiningSystemVersion]
  61.     if {![$defSysV isNil]} {
  62.     if {[$defSysV system] == $sys} {
  63.         return 1
  64.     }
  65.     }
  66.     foreach comp [$this getComponents] {
  67.     if {[$comp system] == $sys} {
  68.         return 1
  69.     }
  70.     }
  71.     return 0
  72. }
  73.  
  74. method CMCodConn::isInFiles {this fileNames} {
  75.     # note: 'fileNames' is an OOList
  76.     set fileName ""
  77.     foreach comp [$this getComponents] {
  78.     set fileName [[[$comp diagram] file] qualifiedName]
  79.     break
  80.     }
  81.     if {$fileName == ""} {
  82.     return 0
  83.     }
  84.     return [expr {[$fileNames search -exact $fileName] != -1}]
  85. }
  86.  
  87. method CMCodConn::isQualified {this} {
  88.     return [regexp "^q" [$this getKind]]
  89. }
  90.  
  91. method CMCodConn::getCadName {this} {
  92.     switch [$this getKind] {
  93.     assoc    { return Association }
  94.     aggr    { return Aggregation }
  95.     qassoc    { return "Qualified Association" }
  96.     default    { return "Qualified Aggregation" }
  97.     }
  98. }
  99.  
  100. method CMCodConn::getCodName {this} {
  101.     switch [$this getKind] {
  102.     assoc    { return Link }
  103.     aggr    { return "Aggregation Link" }
  104.     qassoc    { return "Qualified Link" }
  105.     default    { return "Qualified Aggregation Link" }
  106.     }
  107. }
  108.  
  109. method CMCodConn::setCodConnInfo {this} {
  110.     $this info [CMCodInfo new]
  111.  
  112.     foreach propName {link_start_stereotype link_end_stereotype} {
  113.     set propValue [$this getPropertyValue $propName]
  114.     if {$propValue != "" && $propValue != "association"} {
  115.         return
  116.     }
  117.     }
  118.  
  119.     set name [$this getItem]
  120.     if {![$name isNil]} {
  121.     [$this info] name [$name name]
  122.     }
  123.     set fromRole [$this getItem 0 "role_start" de]
  124.     if {![$fromRole isNil]} {
  125.     [$this info] fromRole [$fromRole name]
  126.     }
  127.     set toRole [$this getItem 0 "role_end" de]
  128.     if {![$toRole isNil]} {
  129.     [$this info] toRole [$toRole name]
  130.     }
  131.     set from [[$this getFrom] getItem 0 "" cl]
  132.     if {![$from isNil]} {
  133.     [$this info] from [$from name]
  134.     }
  135.     set to [[$this getTo] getItem 0 "" cl]
  136.     if {![$to isNil]} {
  137.     [$this info] to [$to name]
  138.     }
  139.     set qualifier [$this getPropertyValue "qual_value"]
  140.     regsub -all "\t\n\r " $qualifier "" qualifier
  141.     [$this info] qualifier $qualifier
  142. }
  143.  
  144. method CMCodConn::mcheck {this} {
  145.     $this setCodConnInfo
  146.     set link [$this info]
  147.     if {[$link from] == "" || [$link to] == ""} {
  148.     return
  149.     }
  150.  
  151.     [[$this getModel] getCadConnInfos [$this getKind]] foreach assoc {
  152.     if {[$assoc from] == "" || [$assoc to] == ""} {
  153.         continue
  154.     }
  155.     if {[$assoc from] == [$link from]} {
  156.         if {[$assoc to] == [$link to] &&
  157.         ([$link name] == "" || [$assoc name] == [$link name]) &&
  158.         [$assoc fromRole] == [$link fromRole] &&
  159.         [$assoc toRole] == [$link toRole] &&
  160.         [$assoc qualifier] == [$link qualifier]} \
  161.         {
  162.         return
  163.         }
  164.     } elseif {[$assoc from] == [$link to]} {
  165.         if {[$assoc to] == [$link from] &&
  166.         ([$link name] == "" || [$assoc name] == [$link name]) &&
  167.         [$assoc fromRole] == [$link toRole] &&
  168.         [$assoc toRole] == [$link fromRole] &&
  169.         [$assoc qualifier] == [$link qualifier]} \
  170.         {
  171.         return
  172.         }
  173.     }
  174.     }
  175.  
  176.     set fileName "???:???"
  177.     foreach comp [$this getComponents] {
  178.     set fileName [[[$comp diagram] file] qualifiedName ":"]
  179.     break
  180.     }
  181.     m4_error $E_LINK_NO_ASSOC [$this getCadName] [$this getCodName] [$link asString [$this isQualified]] $fileName.cod
  182. }
  183.  
  184. # Do not delete this line -- regeneration end marker
  185.  
  186. #---------------------------------------------------------------------------
  187. #      File:           @(#)cmcodinfo.tcl    /main/titanic/1
  188. #---------------------------------------------------------------------------
  189.  
  190. # Start user added include file section
  191. # End user added include file section
  192.  
  193.  
  194. Class CMCodInfo : {GCObject} {
  195.     constructor
  196.     method destructor
  197.     method print
  198.     method asString
  199.     attribute name
  200.     attribute from
  201.     attribute to
  202.     attribute fromRole
  203.     attribute toRole
  204.     attribute qualifier
  205. }
  206.  
  207. constructor CMCodInfo {class this} {
  208.     set this [GCObject::constructor $class $this]
  209.     # Start constructor user section
  210.     # End constructor user section
  211.     return $this
  212. }
  213.  
  214. method CMCodInfo::destructor {this} {
  215.     # Start destructor user section
  216.     # End destructor user section
  217. }
  218.  
  219. method CMCodInfo::print {this {fd stderr}} {
  220.     puts $fd " @@ |[$this from]|\[[$this qualifier]\]-[$this fromRole]---[$this name]---[$this toRole]-|[$this to]|"
  221. }
  222.  
  223. method CMCodInfo::asString {this {isQualified 1}} {
  224.     set str ""
  225.     if {[$this name] != ""} {
  226.     set str "'[$this name]' "
  227.     }
  228.     set str "${str}between Instance of type '[$this from]' and Instance of type '[$this to]'"
  229.     set sep " having "
  230.     if {[$this fromRole] != ""} {
  231.     set str "${str}${sep}start role '[$this fromRole]'"
  232.     set sep ", "
  233.     }
  234.     if {[$this toRole] != ""} {
  235.     set str "${str}${sep}end role '[$this toRole]'"
  236.     set sep " and "
  237.     }
  238.     if {$isQualified} {
  239.     if {$sep == ", "} { set sep " and " }
  240.     set str "${str}${sep}qualifier '[$this qualifier]'"
  241.     }
  242.     return $str
  243. }
  244.  
  245. # Do not delete this line -- regeneration end marker
  246.  
  247. #---------------------------------------------------------------------------
  248. #      File:           @(#)cmcodmodel.tcl    /main/titanic/1
  249. #---------------------------------------------------------------------------
  250.  
  251. # Start user added include file section
  252. # End user added include file section
  253.  
  254.  
  255. Class CMCodModel : {SMPhaseModel} {
  256.     method destructor
  257.     constructor
  258.     method defineSMTypes
  259.     method makeSMTypeName
  260.     method getCadConnInfos
  261.     method mcheck
  262.     method addAssoc
  263.     method removeAssoc
  264.     method addAggr
  265.     method removeAggr
  266.     method addQassoc
  267.     method removeQassoc
  268.     method addQaggr
  269.     method removeQaggr
  270.     attribute assocSet
  271.     attribute aggrSet
  272.     attribute qassocSet
  273.     attribute qaggrSet
  274. }
  275.  
  276. method CMCodModel::destructor {this} {
  277.     # Start destructor user section
  278.     # End destructor user section
  279. }
  280.  
  281. constructor CMCodModel {class this configV phaseV} {
  282.     set this [SMPhaseModel::constructor $class $this $configV $phaseV]
  283.  
  284.     # Define global available SMTypes
  285.     $this defineSMTypes
  286.  
  287.     # Add creator scripts to the ObjectFactory
  288.     set objFac [$this getObjectFactory]
  289.     #
  290.     $objFac addCreatorScript $OMT_COD_Link "
  291.     return \[CMCodLinkConn new $this]
  292.     "
  293.     $objFac addCreatorScript $OMT_COD_AggrLink "
  294.     return \[CMCodAggrLinkConn new $this]
  295.     "
  296.     $objFac addCreatorScript $OMT_COD_QualifLink "
  297.     return \[CMCodQLinkConn new $this]
  298.     "
  299.     $objFac addCreatorScript $OMT_COD_QualifAggrLink "
  300.     return \[CMCodQAggrLinkConn new $this]
  301.     "
  302.     $objFac addCreatorScript $OMT_COD_NaryLink "
  303.     return \[CMCodNAryLink new $this]
  304.     "
  305.  
  306.     return $this
  307. }
  308.  
  309. method CMCodModel::defineSMTypes {this} {
  310.     set typeIter [SMTypeIter new]
  311.     while {[$typeIter current] != ""} {
  312.     set smType [$typeIter current]
  313.     if {!([string match CAD* [$smType name]] || [string match COD* [$smType name]])} {
  314.         $typeIter next
  315.         continue
  316.     }
  317.     set name [$this makeSMTypeName [$smType name]]
  318.     eval "global $name"
  319.     eval "set $name $smType"
  320.     $typeIter next
  321.     }
  322.     $typeIter delete
  323.  
  324.     global ANY; set ANY [SMTypeDB::any]
  325. }
  326.  
  327. method CMCodModel::makeSMTypeName {this type} {
  328.     regsub -all "\[ \t]+" $type "_" type
  329.     return "OMT_$type"
  330. }
  331.  
  332. method CMCodModel::getCadConnInfos {this kind} {
  333.     set lst ${kind}Set
  334.     if {[$this $lst] != ""} {
  335.     return [$this $lst]
  336.     }
  337.  
  338.     switch $kind {
  339.     assoc    { set type $OMT_CAD_Association }
  340.     aggr    { set type $OMT_CAD_Aggregation }
  341.     qassoc    { set type $OMT_CAD_QualAssoc }
  342.     default    { set type $OMT_CAD_QualAggr }
  343.     }
  344.     $this $lst [List new]
  345.     foreach conn [$this getSMObjects $type] {
  346.     set info [CMCodInfo new]
  347.  
  348.     set name [$conn getItem]
  349.     if {![$name isNil]} {
  350.         $info name [$name name]
  351.     }
  352.     set fromRole [$conn getItem 0 "role_start" de]
  353.     if {![$fromRole isNil]} {
  354.         $info fromRole [$fromRole name]
  355.     }
  356.     set toRole [$conn getItem 0 "role_end" de]
  357.     if {![$toRole isNil]} {
  358.         $info toRole [$toRole name]
  359.     }
  360.     set qualifier [$conn getItem 0 "qualifier" de]
  361.     if {![$qualifier isNil]} {
  362.         $info qualifier [$qualifier name]
  363.     }
  364.     set from [[$conn getFrom] getItem 0 "" cl]
  365.     if {![$from isNil]} {
  366.         $info from [$from name]
  367.     }
  368.     set to [[$conn getTo] getItem 0 "" cl]
  369.     if {![$to isNil]} {
  370.         $info to [$to name]
  371.     }
  372.  
  373.     [$this $lst] append $info
  374.     }
  375.     return [$this $lst]
  376. }
  377.  
  378. method CMCodModel::mcheck {this {codNames {}}} {
  379.     # check all Links in *current* system, and optionally in files with
  380.     #  names in 'codNames'
  381.     #
  382.     if {$codNames != {}} {
  383.     set codNameList [List new]
  384.     $codNameList contents $codNames
  385.     }
  386.  
  387.     set links {}
  388.     foreach type "
  389.     $OMT_COD_Link
  390.     $OMT_COD_AggrLink
  391.     $OMT_COD_QualifLink
  392.     $OMT_COD_QualifAggrLink
  393.     " {
  394.     foreach obj [$this getSMObjects $type] {
  395.         if {[[[$obj getTo] getSemType] name] == "Class" && [[[$obj getFrom] getSemType] name] == "Class"} {
  396.         lappend links $obj
  397.         }
  398.     }
  399.     }
  400.     # IMPR: $OMT_COD_NaryLink
  401.  
  402.     foreach link $links {
  403.     if {$link == ""} continue
  404.     if {[$link isInSystem] && ($codNames == {} || [$link isInFiles $codNameList])} {
  405.         $link mcheck
  406.     }
  407.     }
  408. }
  409.  
  410. # Do not delete this line -- regeneration end marker
  411.  
  412. method CMCodModel::addAssoc {this newAssoc} {
  413.     [$this assocSet] append $newAssoc
  414.  
  415. }
  416.  
  417. method CMCodModel::removeAssoc {this oldAssoc} {
  418.     [$this assocSet] removeValue $oldAssoc
  419. }
  420.  
  421. method CMCodModel::addAggr {this newAggr} {
  422.     [$this aggrSet] append $newAggr
  423.  
  424. }
  425.  
  426. method CMCodModel::removeAggr {this oldAggr} {
  427.     [$this aggrSet] removeValue $oldAggr
  428. }
  429.  
  430. method CMCodModel::addQassoc {this newQassoc} {
  431.     [$this qassocSet] append $newQassoc
  432.  
  433. }
  434.  
  435. method CMCodModel::removeQassoc {this oldQassoc} {
  436.     [$this qassocSet] removeValue $oldQassoc
  437. }
  438.  
  439. method CMCodModel::addQaggr {this newQaggr} {
  440.     [$this qaggrSet] append $newQaggr
  441.  
  442. }
  443.  
  444. method CMCodModel::removeQaggr {this oldQaggr} {
  445.     [$this qaggrSet] removeValue $oldQaggr
  446. }
  447.  
  448. #---------------------------------------------------------------------------
  449. #      File:           @(#)cmcodnaryl.tcl    /main/titanic/1
  450. #---------------------------------------------------------------------------
  451.  
  452. # Start user added include file section
  453. # End user added include file section
  454.  
  455.  
  456. Class CMCodNAryLink : {SMNode} {
  457.     method destructor
  458.     constructor
  459.     method isInSystem
  460.     method mcheck
  461. }
  462.  
  463. method CMCodNAryLink::destructor {this} {
  464.     # Start destructor user section
  465.     # End destructor user section
  466. }
  467.  
  468. constructor CMCodNAryLink {class this inModel} {
  469.     set this [SMNode::constructor $class $this $inModel]
  470.     return $this
  471. }
  472.  
  473. method CMCodNAryLink::isInSystem {this {sys ""}} {
  474.     # if not supplied, use current system for 'sys'
  475.     #
  476.     if {$sys == ""} {
  477.     set sys [[[ClientContext::global] currentSystem] system]
  478.     }
  479.     set defSysV [$this getDefiningSystemVersion]
  480.     if {![$defSysV isNil]} {
  481.     if {[$defSysV system] == $sys} {
  482.         return 1
  483.     }
  484.     }
  485.     foreach comp [$this getComponents] {
  486.     if {[$comp system] == $sys} {
  487.         return 1
  488.     }
  489.     }
  490.     return 0
  491. }
  492.  
  493. method CMCodNAryLink::mcheck {this} {
  494. }
  495.  
  496. # Do not delete this line -- regeneration end marker
  497.  
  498. #---------------------------------------------------------------------------
  499. #      File:           @(#)cmcodlinkc.tcl    /main/titanic/1
  500. #---------------------------------------------------------------------------
  501.  
  502. # Start user added include file section
  503. # End user added include file section
  504.  
  505.  
  506. Class CMCodLinkConn : {CMCodConn} {
  507.     method destructor
  508.     constructor
  509.     method getKind
  510. }
  511.  
  512. method CMCodLinkConn::destructor {this} {
  513.     # Start destructor user section
  514.     # End destructor user section
  515.     $this CMCodConn::destructor
  516. }
  517.  
  518. constructor CMCodLinkConn {class this inModel} {
  519.     set this [CMCodConn::constructor $class $this $inModel]
  520.     return $this
  521. }
  522.  
  523. method CMCodLinkConn::getKind {this} {
  524.     return assoc
  525. }
  526.  
  527. # Do not delete this line -- regeneration end marker
  528.  
  529. #---------------------------------------------------------------------------
  530. #      File:           @(#)cmcodqlink.tcl    /main/titanic/1
  531. #---------------------------------------------------------------------------
  532.  
  533. # Start user added include file section
  534. # End user added include file section
  535.  
  536.  
  537. Class CMCodQLinkConn : {CMCodLinkConn} {
  538.     method destructor
  539.     constructor
  540.     method getKind
  541. }
  542.  
  543. method CMCodQLinkConn::destructor {this} {
  544.     # Start destructor user section
  545.     # End destructor user section
  546.     $this CMCodLinkConn::destructor
  547. }
  548.  
  549. constructor CMCodQLinkConn {class this inModel} {
  550.     set this [CMCodLinkConn::constructor $class $this $inModel]
  551.     return $this
  552. }
  553.  
  554. method CMCodQLinkConn::getKind {this} {
  555.     return qassoc
  556. }
  557.  
  558. # Do not delete this line -- regeneration end marker
  559.  
  560. #---------------------------------------------------------------------------
  561. #      File:           @(#)cmcodaggrl.tcl    /main/titanic/1
  562. #---------------------------------------------------------------------------
  563.  
  564. # Start user added include file section
  565. # End user added include file section
  566.  
  567.  
  568. Class CMCodAggrLinkConn : {CMCodConn} {
  569.     method destructor
  570.     constructor
  571.     method getKind
  572. }
  573.  
  574. method CMCodAggrLinkConn::destructor {this} {
  575.     # Start destructor user section
  576.     # End destructor user section
  577.     $this CMCodConn::destructor
  578. }
  579.  
  580. constructor CMCodAggrLinkConn {class this inModel} {
  581.     set this [CMCodConn::constructor $class $this $inModel]
  582.     return $this
  583. }
  584.  
  585. method CMCodAggrLinkConn::getKind {this} {
  586.     return aggr
  587. }
  588.  
  589. # Do not delete this line -- regeneration end marker
  590.  
  591. #---------------------------------------------------------------------------
  592. #      File:           @(#)cmcodqaggr.tcl    /main/titanic/1
  593. #---------------------------------------------------------------------------
  594.  
  595. # Start user added include file section
  596. # End user added include file section
  597.  
  598.  
  599. Class CMCodQAggrLinkConn : {CMCodAggrLinkConn} {
  600.     method destructor
  601.     constructor
  602.     method getKind
  603. }
  604.  
  605. method CMCodQAggrLinkConn::destructor {this} {
  606.     # Start destructor user section
  607.     # End destructor user section
  608.     $this CMCodAggrLinkConn::destructor
  609. }
  610.  
  611. constructor CMCodQAggrLinkConn {class this inModel} {
  612.     set this [CMCodAggrLinkConn::constructor $class $this $inModel]
  613.     return $this
  614. }
  615.  
  616. method CMCodQAggrLinkConn::getKind {this} {
  617.     return qaggr
  618. }
  619.  
  620. # Do not delete this line -- regeneration end marker
  621.  
  622.