home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / chkmodel.tcl < prev    next >
Text File  |  1997-12-01  |  101KB  |  3,562 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            : chkmodel.tcl
  17. #       Author          : heli
  18. #       Original date   : November 1997
  19. #       Description     : Checking local/global/usecase/target model
  20. #
  21. #---------------------------------------------------------------------------
  22.  
  23. #---------------------------------------------------------------------------
  24. #      File:           @(#)cmcmnattr.tcl    /main/titanic/1
  25. #---------------------------------------------------------------------------
  26.  
  27. # Start user added include file section
  28. # End user added include file section
  29.  
  30.  
  31. Class CMCmnAttr : {Object} {
  32.     constructor
  33.     method destructor
  34.     method copyAccessMode
  35. }
  36.  
  37. constructor CMCmnAttr {class this} {
  38.     set this [Object::constructor $class $this]
  39.     # Start constructor user section
  40.     # End constructor user section
  41.     return $this
  42. }
  43.  
  44. method CMCmnAttr::destructor {this} {
  45.     # Start destructor user section
  46.     # End destructor user section
  47. }
  48.  
  49. method CMCmnAttr::copyAccessMode {this oper rwMode} {
  50.     #
  51.     # Based on the access mode of an attribute (data/assoc), set the
  52.     # method access of a synthetic operation that is generated from
  53.     # that attribute.
  54.     #
  55.     # 'rwMode' is r if oper is a read operation, w if it's a write operation
  56.     #
  57.     if {$oper == ""} {
  58.     return
  59.     }
  60.  
  61.     set rw [$this getAccessMode]
  62.     if {$rw == ""} {
  63.     set rw {Public Public}
  64.     } else {
  65.     set rw [split $rw -]
  66.     }
  67.     set rwIndex [expr {$rwMode == "r" ? "0" : "1"}]
  68.     $oper addRunTimeProperty method_access [lindex $rw $rwIndex]
  69.  
  70.     if {$debug} {
  71.     puts "    >>> copyAccessMode [$this getName] [$oper getName]\
  72.                     [$oper getPropertyValue method_access]"
  73.     }
  74. }
  75.  
  76. # Do not delete this line -- regeneration end marker
  77.  
  78. #---------------------------------------------------------------------------
  79. #      File:           @(#)cmcmnevent.tcl    /main/titanic/1
  80. #---------------------------------------------------------------------------
  81.  
  82. # Start user added include file section
  83. # End user added include file section
  84.  
  85.  
  86. Class CMCmnEvent : {Object} {
  87.     constructor
  88.     method destructor
  89.     method inDiagram
  90. }
  91.  
  92. constructor CMCmnEvent {class this} {
  93.     set this [Object::constructor $class $this]
  94.     # Start constructor user section
  95.     # End constructor user section
  96.     return $this
  97. }
  98.  
  99. method CMCmnEvent::destructor {this} {
  100.     # Start destructor user section
  101.     # End destructor user section
  102. }
  103.  
  104. method CMCmnEvent::inDiagram {this diagram} {
  105.     #
  106.     # Return 1 if this event belongs to the given diagram, else 0.
  107.     #
  108.     set colon [string first "/" $diagram]
  109.     if {$colon != -1} {
  110.     incr colon
  111.     set diagram [string range $diagram $colon end]
  112.     }
  113.     return [expr {$diagram == "[$this getDiagramName].[$this getDiagramType]"}]
  114. }
  115.  
  116. # Do not delete this line -- regeneration end marker
  117.  
  118. #---------------------------------------------------------------------------
  119. #      File:           @(#)cmcmnopera.tcl    /main/titanic/2
  120. #---------------------------------------------------------------------------
  121.  
  122. # Start user added include file section
  123. # End user added include file section
  124.  
  125.  
  126. Class CMCmnOperation : {Object} {
  127.     constructor
  128.     method destructor
  129.     method mcheck
  130. }
  131.  
  132. constructor CMCmnOperation {class this} {
  133.     set this [Object::constructor $class $this]
  134.     # Start constructor user section
  135.     # End constructor user section
  136.     return $this
  137. }
  138.  
  139. method CMCmnOperation::destructor {this} {
  140.     # Start destructor user section
  141.     # End destructor user section
  142. }
  143.  
  144. method CMCmnOperation::mcheck {this class} {
  145. my_debug "CMCmnOperation::mcheck()"
  146.     set name [$class getName]
  147.     if {[$this getName] == $name} {
  148.     # check is language dependent...
  149.         # m4_error $E_ILLEGAL_CONSTRUCTOR $name
  150.     }
  151.  
  152.     foreach p [get_parameters $this] {
  153.         $p mcheck $this $class
  154.     }
  155. }
  156.  
  157. # Do not delete this line -- regeneration end marker
  158.  
  159. #---------------------------------------------------------------------------
  160. #      File:           @(#)cmcmntype.tcl    /main/titanic/1
  161. #---------------------------------------------------------------------------
  162.  
  163. # Start user added include file section
  164. # End user added include file section
  165.  
  166.  
  167. Class CMCmnType : {Object} {
  168.     constructor
  169.     method destructor
  170.     method prepare
  171. }
  172.  
  173. constructor CMCmnType {class this} {
  174.     set this [Object::constructor $class $this]
  175.     # Start constructor user section
  176.     # End constructor user section
  177.     return $this
  178. }
  179.  
  180. method CMCmnType::destructor {this} {
  181.     # Start destructor user section
  182.     # End destructor user section
  183. }
  184.  
  185. method CMCmnType::prepare {this class model forwhat} {
  186. my_debug "CMCmnType::prepare()"
  187.     # empty
  188. }
  189.  
  190. # Do not delete this line -- regeneration end marker
  191.  
  192. #---------------------------------------------------------------------------
  193. #      File:           @(#)cmeventrec.tcl    /main/titanic/1
  194. #---------------------------------------------------------------------------
  195.  
  196. # Start user added include file section
  197. # End user added include file section
  198.  
  199.  
  200. Class CMEventReceiver : {Object} {
  201.     constructor
  202.     method destructor
  203.     method setReceivedEvents
  204.     method getReceivedEvents
  205.     attribute receivedEvents
  206.     attribute eventTypes
  207.     attribute eventDiagram
  208. }
  209.  
  210. constructor CMEventReceiver {class this} {
  211.     set this [Object::constructor $class $this]
  212.     # Start constructor user section
  213.     # End constructor user section
  214.     return $this
  215. }
  216.  
  217. method CMEventReceiver::destructor {this} {
  218.     # Start destructor user section
  219.     # End destructor user section
  220. }
  221.  
  222. method CMEventReceiver::setReceivedEvents {this eventTypes eventDiagram} {
  223.     $this receivedEvents {}
  224.     $this eventTypes $eventTypes
  225.     $this eventDiagram $eventDiagram
  226. }
  227.  
  228. method CMEventReceiver::getReceivedEvents {this {eventTypes {}} {eventDiagram ""}} {
  229.     # Return the received events that are defined in (this) eventDiagram or in
  230.     # a diagram with a type that is present in (this) eventTypes
  231.     # The result is cached, if no 'eventTypes' and 'eventDiagram'
  232.     #
  233.     set cache 0
  234.     if {$eventTypes == {} && $eventDiagram == ""} {
  235.     set cache 1
  236.     if {[$this receivedEvents] != {}} {
  237.         return [$this receivedEvents]
  238.     }
  239.     }
  240.  
  241.     if {$eventTypes == {}} {
  242.     set eventTypes [$this eventTypes]
  243.     }
  244.     if {$eventDiagram == ""} {
  245.     set eventDiagram [$this eventDiagram]
  246.     }
  247.     if {$eventTypes == {} && $eventDiagram == ""} {
  248.     return {}
  249.     }
  250.  
  251.     set receivedEvents {}
  252.     foreach recvEv [$this receivedEventSet] {
  253.     if {$eventDiagram != "" && $eventDiagram == "[$recvEv getDiagramName].[$recvEv getDiagramType]"} {
  254.         lappend receivedEvents $recvEv
  255.         continue
  256.     }
  257.     if {$eventTypes == {} || [lsearch $eventTypes [$recvEv getDiagramType]] == -1} {
  258.         continue
  259.     }
  260.     lappend receivedEvents $recvEv
  261.     }
  262.  
  263.     if {$cache} {
  264.     $this receivedEvents $receivedEvents
  265.     }
  266.     return $receivedEvents
  267. }
  268.  
  269. # Do not delete this line -- regeneration end marker
  270.  
  271. #---------------------------------------------------------------------------
  272. #      File:           @(#)cmodel.tcl    /main/titanic/3
  273. #---------------------------------------------------------------------------
  274.  
  275. # Start user added include file section
  276. # End user added include file section
  277.  
  278.  
  279. Class CModel : {OOPLModel} {
  280.     constructor
  281.     method destructor
  282.     method mcheck
  283.     method prepare
  284.     method getDBObjectClass
  285.     method findClass
  286. }
  287.  
  288. constructor CModel {class this} {
  289.     set this [OOPLModel::constructor $class $this]
  290.     # Start constructor user section
  291.     # End constructor user section
  292.     return $this
  293. }
  294.  
  295. method CModel::destructor {this} {
  296.     # Start destructor user section
  297.     # End destructor user section
  298. }
  299.  
  300. selfPromoter OOPLModel {this} {
  301.     CModel promote $this
  302. }
  303.  
  304. method CModel::mcheck {this ooplClasses ooplSubjects} {
  305. my_debug "CModel::mcheck()"
  306.     foreach class $ooplClasses {
  307.         if {![$class isSynthetic]} {
  308.         if {[$class isExternal]} {
  309.         puts stdout "\nClass '[$class getName]' is external, not checked."
  310.         continue
  311.         }
  312.         $class mcheck
  313.         }
  314.     }
  315.  
  316.     foreach subject $ooplSubjects {
  317.         m4_message $M_CHECKING_SUBJECT [$subject getName]
  318.         $subject mcheck
  319.     }
  320. }
  321.  
  322. method CModel::prepare {this ooplClasses ooplSubjects forwhat} {
  323. my_debug "CModel::prepare()"
  324.     add_predefined_methods $this
  325.  
  326.     foreach class $ooplClasses {
  327.         if {![$class isSynthetic]} {
  328.         $class prepare $this $forwhat
  329.         }
  330.     }
  331.     #foreach subject [$this subjectSet]
  332.     foreach subject $ooplSubjects {
  333.         $this prepare $subject $forwhat
  334.     }
  335.  
  336.     foreach class $ooplClasses {
  337.         #
  338.     # add these attributes for more efficient operation of some of the
  339.         # checks; these are only needed if there are any received_events
  340.         # can only be done after all classes have been prepared, due to
  341.         # extra operations/super classes added via addOperation or
  342.         # add_super_class
  343.         #
  344.     if {[$class getReceivedEvents] != {}} {
  345.         $class addRunTimeProperty methods [$class findMethods 0]
  346.         $class addRunTimeProperty flat_methods [$class findMethods 1]
  347.     }
  348.     }
  349. }
  350.  
  351. method CModel::getDBObjectClass {this} {
  352.     #
  353.     # Return the handle of the DBObject class for this OoplModel.
  354.     #
  355.     set dbobject [$this findClass "DBObject"]
  356.     if {$dbobject == ""} {
  357.     set dbobject [$this addClass "DBObject" db_class]
  358.     }
  359.     return $dbobject
  360. }
  361.  
  362. method CModel::findClass {this name {feat ""}} {
  363.     #
  364.     #  Given a class name and optionally an operation name, find the class
  365.     #  and feature handles of the class with name 'name' and all features
  366.     #  with name 'feat' in this OoplModel.  'feat' may be a glob-style
  367.     #  pattern.
  368.     #
  369.     #  Returns a list of one or more elements, the first being the class handle,
  370.     #  the rest operation handles.  If the class was not found, returns "".
  371.     #
  372.     set c [$this classByName $name]
  373.  
  374.     if {"$c" == ""} {
  375.     return ""
  376.     }
  377.  
  378.     if {$feat != ""} {
  379.     set flist ""
  380.  
  381.     foreach f [$c featureSet] {
  382.         if [string match $feat [$f getName]] {
  383.         lappend flist $f
  384.         }
  385.     }
  386.  
  387.     return "$c $flist"
  388.     }
  389.  
  390.     return $c
  391. }
  392.  
  393. # Do not delete this line -- regeneration end marker
  394.  
  395. #---------------------------------------------------------------------------
  396. #      File:           @(#)cmparamete.tcl    /main/titanic/1
  397. #---------------------------------------------------------------------------
  398.  
  399. # Start user added include file section
  400. # End user added include file section
  401.  
  402.  
  403. Class CMParameter : {Object} {
  404.     constructor
  405.     method destructor
  406.     method mcheck
  407. }
  408.  
  409. constructor CMParameter {class this} {
  410.     set this [Object::constructor $class $this]
  411.     # Start constructor user section
  412.     # End constructor user section
  413.     return $this
  414. }
  415.  
  416. method CMParameter::destructor {this} {
  417.     # Start destructor user section
  418.     # End destructor user section
  419. }
  420.  
  421. method CMParameter::mcheck {this oper class} {
  422. my_debug "CMParameter::mcheck()"
  423.     # empty
  424. }
  425.  
  426. # Do not delete this line -- regeneration end marker
  427.  
  428. #---------------------------------------------------------------------------
  429. #      File:           @(#)cmcmnclass.tcl    /main/titanic/6
  430. #---------------------------------------------------------------------------
  431.  
  432. # Start user added include file section
  433. # End user added include file section
  434.  
  435.  
  436. Class CMCmnClass : {CMEventReceiver} {
  437.     constructor
  438.     method destructor
  439.     method mcheck
  440.     method prepare
  441.     method checkDirectSupers
  442.     method checkClassAttributes
  443.     method checkClassOperations
  444.     method checkClassAssociations
  445.     method causesConflict
  446.     method makeKeyParamList
  447.     method isRootClass
  448.     method findDataAttrs
  449.     method findAssocAttrs
  450.     method findMethods
  451.     method findEventMethod
  452. }
  453.  
  454. global CMCmnClass::visitedSupers
  455. set CMCmnClass::visitedSupers {}
  456.  
  457.  
  458. constructor CMCmnClass {class this} {
  459.     set this [CMEventReceiver::constructor $class $this]
  460.     # Start constructor user section
  461.     # End constructor user section
  462.     return $this
  463. }
  464.  
  465. method CMCmnClass::destructor {this} {
  466.     # Start destructor user section
  467.     # End destructor user section
  468.     $this CMEventReceiver::destructor
  469. }
  470.  
  471. method CMCmnClass::mcheck {this} {
  472. my_debug "CMCmnClass::mcheck()"
  473.     m4_message $M_CHECKING_CLASS [$this getName]
  474.  
  475.     $this checkDirectSupers
  476.     $this checkClassAttributes
  477.     $this checkClassOperations
  478.     $this checkClassAssociations
  479.  
  480.     foreach feat [$this featureSet] {
  481.         if {![$feat isSynthetic]} {
  482.             $feat mcheck $this
  483.         }
  484.     }
  485.  
  486.     foreach recvEv [$this getReceivedEvents] {
  487.         $recvEv mcheck $this
  488.     }
  489. }
  490.  
  491. method CMCmnClass::prepare {this model forwhat} {
  492. my_debug "CMCmnClass::prepare()"
  493.     foreach feat [$this featureSet] {
  494.         if {![$feat isSynthetic]} {
  495.         $feat prepare $this $model $forwhat
  496.         }
  497.     }
  498. }
  499.  
  500. method CMCmnClass::checkDirectSupers {this} {
  501.     #
  502.     # Check if this class does not directly inherit from the same
  503.     # class more than once.
  504.     #
  505.     set superNames {}
  506.     foreach gen [$this genNodeSet] {
  507.         lappend superNames [$gen getSuperClassName]
  508.     }
  509.  
  510.     # remove all unique names from superNames
  511.     set uniqueSupers [CheckUtil::findUniqueNames $superNames]
  512.     foreach super $uniqueSupers {
  513.     set idx [lsearch $superNames $super]
  514.     set superNames [lreplace $superNames $idx $idx]
  515.     }
  516.  
  517.     # any name left indicates an error
  518.     foreach super [CheckUtil::findUniqueNames $superNames] {
  519.     m4_error $E_SAME_DIRECT_SUPERS [$this getName] $super
  520.     }
  521. }
  522.  
  523. method CMCmnClass::checkClassAttributes {this} {
  524.     #
  525.     # check data attribute against all assoc_attribs
  526.     #
  527.     foreach attrib [$this dataAttrSet] {
  528.     set name [$attrib getName]
  529.     foreach assoc [$this genAssocAttrSet] {
  530.         if {[$assoc getName] == $name &&
  531.         [$assoc getMultiplicity] == "one"} {
  532.             m4_error $E_CONFLICTING_DATA_AND_ASSOC_ATTRIB \
  533.             [$this getName] $name [CheckUtil::getDiagram $assoc]
  534.         }
  535.     }
  536.     }
  537.  
  538.     # check assoc_attribute
  539.  
  540.     foreach assoc1 [$this genAssocAttrSet] {
  541.     foreach assoc2 [$this genAssocAttrSet] {
  542.         # Trick to prevent double checks.
  543.         if {$assoc1 >= $assoc2} {
  544.         continue
  545.         }
  546.  
  547.         if [$this causesConflict $assoc1 $assoc2] {
  548.         m4_error $E_CONFLICTING_ASSOC_ATTRIBS \
  549.             [$this getName] [$assoc1 getName] \
  550.             [CheckUtil::getDiagram $assoc1] [CheckUtil::getDiagram $assoc2]
  551.         }
  552.     }
  553.     }
  554. }
  555.  
  556. method CMCmnClass::checkClassOperations {this} {
  557.     # nothing to check here
  558. }
  559.  
  560. method CMCmnClass::checkClassAssociations {this} {
  561.     #
  562.     # Check if this class has unique names for all associations.
  563.     #
  564.     # Only for assoc_attribs that have a "link", since only there the
  565.     # association name is used by the code-generator.
  566.     #
  567.     foreach a [$this genAssocAttrSet] {
  568.     set a_link [get_link $a]
  569.     if {$a_link != ""} {
  570.         foreach b [$this genAssocAttrSet] {
  571.         # Trick to prevent double checks.
  572.         if {$a >= $b} {
  573.             continue
  574.         }
  575.         set b_link [get_link $b]
  576.         if {$b_link != ""} {
  577.             set a_relation [$a_link relation]
  578.             set b_relation [$b_link relation]
  579.             if {$a_relation != $b_relation} {
  580.             # if they're the same, this class is a link class, with
  581.             # links to both association classes, but only one
  582.             # association.
  583.             set a_name [$a_relation getName]
  584.             set b_name [$b_relation getName]
  585.             if {$a_name == $b_name && $a_name != ""} {
  586.                 set diags "[CheckUtil::getDiagram $a] [CheckUtil::getDiagram $b]"
  587.                 if {[lindex $diags 0] == [lindex $diags 1]} {
  588.                 set diags " [lindex $diags 0]"
  589.                 } else {
  590.                 set diags "s [join $diags " and "]"
  591.                 }
  592.                 m4_error $E_CONFLICTING_ASSOC_NAMES \
  593.                      [$this getName] $a_name $diags
  594.             }
  595.             }
  596.         }
  597.         }
  598.     }
  599.     }
  600. }
  601.  
  602. method CMCmnClass::causesConflict {this assoc1 assoc2} {
  603.     #
  604.     # Check if the attribute names of this class are unique; includes checking
  605.     # for duplicate assoc_attribs.  Duplicate attribute names are checked for
  606.     # while loading the model, because these are certain to cause collisions.
  607.     #
  608.     # These checks see if methods generated from data_ and assoc_attribs
  609.     # will confict.  This can only happen in these cases:
  610.     #
  611.     #     - between a data_attrib and an assoc_attrib that have the same name,
  612.     #    and where the assoc_attrib has a multiplicity of one,
  613.     #
  614.     #     - between two assoc_attribs with the same name, compatible types
  615.     #    and same multiplicity.
  616.     #
  617.     set type1 [$assoc1 get_obj_type]
  618.     set type2 [$assoc2 get_obj_type]
  619.  
  620.     return [expr {
  621.     $assoc1 != $assoc2 &&
  622.     [$assoc1 getName] == [$assoc2 getName] &&
  623.     [$assoc1 getMultiplicity] == [$assoc2 getMultiplicity] &&
  624.         ($type1 == $type2 || "db_$type1" == $type2 || $type1 == "db_$type2")
  625.     }]
  626. }
  627.  
  628. method CMCmnClass::makeKeyParamList {this} {
  629.     #
  630.     # Create a paramList for use with add_operation.  The parameters consist
  631.     # of those attributes that are key attributes of this class.
  632.     #
  633.     set params ""
  634.     foreach key [get_col_list [$this table] KEYS] {
  635.     lappend params "[$key getName] [$key getTypeStd]"
  636.     }
  637.     return $params
  638. }
  639.  
  640. method CMCmnClass::isRootClass {this} {
  641.     #
  642.     # Check if this class is a real root class, i.e. has no non-synthetic
  643.     # superclasses
  644.     #
  645.     set supers [$this genNodeSet]
  646.     if [lempty $supers] {
  647.     return 1
  648.     }
  649.     foreach g $supers {
  650.     if {[$g isSynthetic] != "1"} {
  651.         return 0
  652.     }
  653.     }
  654.     return 1;
  655. }
  656.  
  657. method CMCmnClass::findDataAttrs {this {super 0} {_isRecCall 0}} {
  658.     #
  659.     # Return a list of data attributes of this class.
  660.     #
  661.     # If 'super' is 1, attributes of superclasses are included as well.
  662.     # '_isRecCall' is used for *internal* purpose only
  663.     #
  664.     global CMCmnClass::visitedSupers
  665.     if {$super == 1} {
  666.     if {!$_isRecCall} {
  667.         set CMCmnClass::visitedSupers {}
  668.     } elseif {[lsearch -exact ${CMCmnClass::visitedSupers} $this] != -1} {
  669.         # been here already
  670.         return {}
  671.     }
  672.     }
  673.     set attrs [$this dataAttrSet]
  674.  
  675.     if {$super == 1} {
  676.     lappend CMCmnClass::visitedSupers $this
  677.     foreach g [$this genNodeSet] {
  678.         set new [[$g superClass] findDataAttrs 1 1]
  679.         if {$new != {}} {
  680.         eval "lappend attrs $new"
  681.         }
  682.     }
  683.     }
  684.  
  685.     return $attrs
  686. }
  687.  
  688. method CMCmnClass::findAssocAttrs {this {super 0} {_isRecCall 0}} {
  689.     #
  690.     # Return a list of association attributes of this class.
  691.     #
  692.     # If 'super' is 1, attributes of superclasses are included as well.
  693.     # '_isRecCall' is used for *internal* purpose only
  694.     #
  695.     global CMCmnClass::visitedSupers
  696.     if {$super == 1} {
  697.     if {!$_isRecCall} {
  698.         set CMCmnClass::visitedSupers {}
  699.     } elseif {[lsearch -exact ${CMCmnClass::visitedSupers} $this] != -1} {
  700.         # been here already
  701.         return {}
  702.     }
  703.     }
  704.     set attrs [$this genAssocAttrSet]
  705.  
  706.     if {$super == 1} {
  707.     lappend CMCmnClass::visitedSupers $this
  708.     foreach g [$this genNodeSet] {
  709.         set new [[$g superClass] findAssocAttrs 1 1]
  710.         if {$new != {}} {
  711.         eval "lappend attrs $new"
  712.         }
  713.     }
  714.     }
  715.  
  716.     return $attrs
  717. }
  718.  
  719. method CMCmnClass::findMethods {this {super 0} {_isRecCall 0}} {
  720.     #
  721.     # Return a list of methods of this class.
  722.     #
  723.     # If 'super' is 1, methods of superclasses are included as well.
  724.     # '_isRecCall' is used for *internal* purpose only
  725.     #
  726.     global CMCmnClass::visitedSupers
  727.     if {$super == 1} {
  728.     if {!$_isRecCall} {
  729.         set CMCmnClass::visitedSupers {}
  730.     } elseif {[lsearch -exact ${CMCmnClass::visitedSupers} $this] != -1} {
  731.         # been here already
  732.         return {}
  733.     }
  734.     }
  735.     set opers [$this operationSet]
  736.  
  737.     if {$super == 1} {
  738.     lappend CMCmnClass::visitedSupers $this
  739.     foreach g [$this genNodeSet] {
  740.         set new [[$g superClass] findMethods 1 1]
  741.         if {$new != {}} {
  742.         eval "lappend opers $new"
  743.         }
  744.     }
  745.     }
  746.  
  747.     return $opers
  748. }
  749.  
  750. method CMCmnClass::findEventMethod {this flatView eventName nattrs access upInfo} {
  751. my_debug "CMCmnClass::findEventMethod()"
  752.     #
  753.     # Given a single event name, see if the event is handled by
  754.     # this class.  This is so if the class has an operation with the
  755.     # same name as the event.  Also check if the operation found has at least
  756.     # accessibility as specified by 'access'.
  757.     #
  758.     # If 'nattrs' is >= 0, the operation must have the same number of parameters
  759.     # as the specified number, if 'nattrs' == -1 the parameter count of the
  760.     # operation is ignored.
  761.     #
  762.     # Returns:
  763.     #    0 if a matching operation is found (correct parameters and access
  764.     #       rights),
  765.     #    1 if no operation is found at all,
  766.     #    2 if an operation is found with the correct name but with the wrong
  767.     #        number of parameters,
  768.     #    3 if a matching operation was found, but with the wrong accessibility.
  769.     #
  770.     upvar $upInfo info
  771.     if {$flatView} {
  772.     set opers [$this getPropertyValue flat_methods]
  773.     } else {
  774.     set opers [$this operationSet]
  775.     }
  776.     set found_name 0
  777.     set bad_access 0
  778.     foreach o $opers {
  779.         if {[$o getName] != $eventName} {
  780.             continue
  781.         }
  782.  
  783.         # found one, if attributes need not be checked, we're done
  784.     if {$nattrs == -1} {
  785.             if [$o checkAccess $access] {
  786.                 return 0
  787.             } else {
  788.                 set bad_access 1
  789.                 set info [$o getPropertyValue method_access]
  790.                 continue
  791.             }
  792.         }
  793.  
  794.     # found one, check if parameters match attributes
  795.         if {[llength [get_parameters $o]] == $nattrs} {
  796.             if [$o checkAccess $access] {
  797.                 return 0
  798.             } else {
  799.                 set bad_access 1
  800.                 set info [$o getPropertyValue method_access]
  801.             }
  802.     } else {
  803.             # remember that a correct name was found
  804.             set found_name 1
  805.             set info [llength [get_parameters $o]]
  806.         }
  807.     }
  808.     if $found_name {
  809.         return 2
  810.     }
  811.     if $bad_access {
  812.         return 3
  813.     }
  814.     return 1
  815. }
  816.  
  817. # Do not delete this line -- regeneration end marker
  818.  
  819. #---------------------------------------------------------------------------
  820. #      File:           @(#)cmspecialc.tcl    /main/titanic/2
  821. #---------------------------------------------------------------------------
  822.  
  823. # Start user added include file section
  824. # End user added include file section
  825.  
  826.  
  827. Class CMSpecialClass : {CMCmnClass} {
  828.     constructor
  829.     method destructor
  830.     method mcheck
  831.     method prepare
  832. }
  833.  
  834. constructor CMSpecialClass {class this} {
  835.     set this [CMCmnClass::constructor $class $this]
  836.     # Start constructor user section
  837.     # End constructor user section
  838.     return $this
  839. }
  840.  
  841. method CMSpecialClass::destructor {this} {
  842.     # Start destructor user section
  843.     # End destructor user section
  844.     $this CMCmnClass::destructor
  845. }
  846.  
  847. method CMSpecialClass::mcheck {this} {
  848. my_debug "CMSpecialClass::mcheck()"
  849.     m4_message $M_CHECKING_CLASS [$this getName]
  850.     #
  851.     # The given class is a special class, not allowed to receive events
  852.     #
  853.     foreach recvEv [$this getReceivedEvents] {
  854.     $recvEv m4Error [$recvEv getEventType] E_CLASS_CANNOT_RECEIVE [$this getName] [$recvEv asStr] [$this get_obj_type]
  855.     }
  856. }
  857.  
  858. method CMSpecialClass::prepare {this model forwhat} {
  859.     # empty
  860. }
  861.  
  862. # Do not delete this line -- regeneration end marker
  863.  
  864. #---------------------------------------------------------------------------
  865. #      File:           @(#)cmclassgen.tcl    /main/titanic/1
  866. #---------------------------------------------------------------------------
  867.  
  868. # Start user added include file section
  869. # End user added include file section
  870.  
  871.  
  872. Class CMClassGenericTypeDef : {CMSpecialClass OPClassGenericTypeDef} {
  873.     constructor
  874.     method destructor
  875. }
  876.  
  877. constructor CMClassGenericTypeDef {class this} {
  878.     set this [CMSpecialClass::constructor $class $this]
  879.     set this [OPClassGenericTypeDef::constructor $class $this]
  880.     # Start constructor user section
  881.     # End constructor user section
  882.     return $this
  883. }
  884.  
  885. method CMClassGenericTypeDef::destructor {this} {
  886.     # Start destructor user section
  887.     # End destructor user section
  888.     $this CMSpecialClass::destructor
  889. }
  890.  
  891. selfPromoter OPClassGenericTypeDef {this} {
  892.     CMClassGenericTypeDef promote $this
  893. }
  894.  
  895. # Do not delete this line -- regeneration end marker
  896.  
  897. #---------------------------------------------------------------------------
  898. #      File:           @(#)cmcmnassoc.tcl    /main/titanic/1
  899. #---------------------------------------------------------------------------
  900.  
  901. # Start user added include file section
  902. # End user added include file section
  903.  
  904.  
  905. Class CMCmnAssocAttr : {CMCmnAttr Object} {
  906.     constructor
  907.     method destructor
  908.     method mcheck
  909.     method prepareForAssoc
  910.     method prepareForLink
  911.     method getAccessMode
  912. }
  913.  
  914. constructor CMCmnAssocAttr {class this} {
  915.     set this [CMCmnAttr::constructor $class $this]
  916.     set this [Object::constructor $class $this]
  917.     # Start constructor user section
  918.     # End constructor user section
  919.     return $this
  920. }
  921.  
  922. method CMCmnAssocAttr::destructor {this} {
  923.     # Start destructor user section
  924.     # End destructor user section
  925.     $this CMCmnAttr::destructor
  926. }
  927.  
  928. method CMCmnAssocAttr::mcheck {this class} {
  929.     # empty
  930. }
  931.  
  932. method CMCmnAssocAttr::prepareForAssoc {this class model forwhat} {
  933.     #
  934.     # Common prepare dispatch function for associations, works also for
  935.     # database associations.
  936.     # Only prepare for method-generating parts
  937.     #
  938.     set prefix "[$this getMultiplicity]"
  939.     $this ${prefix}GetPrepare $class $model $forwhat
  940.     $this ${prefix}SetPrepare $class $model $forwhat
  941.     $this ${prefix}RemovePrepare $class $model $forwhat
  942. }
  943.  
  944. method CMCmnAssocAttr::prepareForLink {this class model forwhat} {
  945.     #
  946.     # Common generate dispatch function for links
  947.     #
  948.     set prefix "[$this getMultiplicity]"
  949.     $this ${prefix}GetPrepare $class $model $forwhat
  950. }
  951.  
  952. method CMCmnAssocAttr::getAccessMode {this} {
  953.     return [$this getPropertyValue assoc_access]
  954. }
  955.  
  956. # Do not delete this line -- regeneration end marker
  957.  
  958. #---------------------------------------------------------------------------
  959. #      File:           @(#)cmdbassoca.tcl    /main/titanic/1
  960. #---------------------------------------------------------------------------
  961.  
  962. # Start user added include file section
  963. # End user added include file section
  964.  
  965.  
  966. Class CMDBAssocAttr : {CMCmnAssocAttr OPDBAssocAttr} {
  967.     constructor
  968.     method destructor
  969.     method prepare
  970.     method oneGetPrepare
  971.     method oneSetPrepare
  972.     method oneRemovePrepare
  973.     method manyGetPrepare
  974.     method manySetPrepare
  975.     method manyRemovePrepare
  976. }
  977.  
  978. constructor CMDBAssocAttr {class this} {
  979.     set this [CMCmnAssocAttr::constructor $class $this]
  980.     set this [OPDBAssocAttr::constructor $class $this]
  981.     # Start constructor user section
  982.     # End constructor user section
  983.     return $this
  984. }
  985.  
  986. method CMDBAssocAttr::destructor {this} {
  987.     # Start destructor user section
  988.     # End destructor user section
  989.     $this CMCmnAssocAttr::destructor
  990. }
  991.  
  992. selfPromoter OPDBAssocAttr {this} {
  993.     CMDBAssocAttr promote $this
  994. }
  995.  
  996. method CMDBAssocAttr::prepare {this class model forwhat} {
  997. my_debug "CMDBAssocAttr::prepare()"
  998.     $this prepareForAssoc $class $model $forwhat
  999. }
  1000.  
  1001. method CMDBAssocAttr::oneGetPrepare {this class model forwhat} {
  1002.     set type [[$this ooplType] getName]
  1003.     set name [cap [$this getName]]
  1004.  
  1005.     set op [$class addOperation get$name $type]
  1006.     $this copyAccessMode $op r
  1007. }
  1008.  
  1009. method CMDBAssocAttr::oneSetPrepare {this class model forwhat} {
  1010.     set type [[$this ooplType] getName]
  1011.     set name [cap [$this getName]]
  1012.  
  1013.     set op [$class addOperation set$name int]
  1014.     $op addParameter new$name $type
  1015.     $this copyAccessMode $op w
  1016. }
  1017.  
  1018. method CMDBAssocAttr::oneRemovePrepare {this class model forwhat} {
  1019.     if [$this isMandatory] {
  1020.     return
  1021.     }
  1022.     if {[set opp [$this opposite]] != "" &&
  1023.         [$opp get_obj_type] == "db_qual_assoc_attrib"} {
  1024.     return
  1025.     }
  1026.     set name [cap [$this getName]]
  1027.  
  1028.     set op [$class addOperation remove$name int]
  1029.     $this copyAccessMode $op w
  1030. }
  1031.  
  1032. method CMDBAssocAttr::manyGetPrepare {this class model forwhat} {
  1033.     set type [[$this ooplType] getName]
  1034.     set name [$this getName]
  1035.     set settype [set_type_name [$this ooplType]]
  1036.     set setname [cap [set_name $name]]
  1037.  
  1038.     catch {$model addClass $settype}
  1039.     set op [$class addOperation get$setname int]
  1040.     $op addParameter $setname $settype
  1041.  
  1042.     $this copyAccessMode $op r
  1043. }
  1044.  
  1045. method CMDBAssocAttr::manySetPrepare {this class model forwhat} {
  1046.     if {[set opp [$this opposite]] != "" &&
  1047.         [$opp get_obj_type] == "db_qual_assoc_attrib"} {
  1048.     # Can't supply the key for a qualified assoc
  1049.     return
  1050.     }
  1051.     set type [[$this ooplType] getName]
  1052.     set name [cap [$this getName]]
  1053.  
  1054.     set op [$class addOperation add$name int]
  1055.     $op addParameter new$name $type
  1056.     $this copyAccessMode $op w
  1057. }
  1058.  
  1059. method CMDBAssocAttr::manyRemovePrepare {this class model forwhat} {
  1060.     if {[set opp [$this opposite]] != "" &&
  1061.         [$opp get_obj_type] == "db_qual_assoc_attrib"} {
  1062.     return
  1063.     }
  1064.     set type [[$this ooplType] getName]
  1065.     set name [cap [$this getName]]
  1066.  
  1067.     set op [$class addOperation remove$name int]
  1068.     $op addParameter old$name $type
  1069.     $this copyAccessMode $op w
  1070. }
  1071.  
  1072. # Do not delete this line -- regeneration end marker
  1073.  
  1074. #---------------------------------------------------------------------------
  1075. #      File:           @(#)cmqualifas.tcl    /main/titanic/1
  1076. #---------------------------------------------------------------------------
  1077.  
  1078. # Start user added include file section
  1079. # End user added include file section
  1080.  
  1081.  
  1082. Class CMQualifAssocAttr : {CMCmnAssocAttr} {
  1083.     constructor
  1084.     method destructor
  1085.     method mcheck
  1086. }
  1087.  
  1088. constructor CMQualifAssocAttr {class this} {
  1089.     set this [CMCmnAssocAttr::constructor $class $this]
  1090.     # Start constructor user section
  1091.     # End constructor user section
  1092.     return $this
  1093. }
  1094.  
  1095. method CMQualifAssocAttr::destructor {this} {
  1096.     # Start destructor user section
  1097.     # End destructor user section
  1098.     $this CMCmnAssocAttr::destructor
  1099. }
  1100.  
  1101. method CMQualifAssocAttr::mcheck {this class} {
  1102.     $this CMCmnAssocAttr::mcheck $class
  1103. }
  1104.  
  1105. # Do not delete this line -- regeneration end marker
  1106.  
  1107. #---------------------------------------------------------------------------
  1108. #      File:           @(#)cmdbqualli.tcl    /main/titanic/1
  1109. #---------------------------------------------------------------------------
  1110.  
  1111. # Start user added include file section
  1112. # End user added include file section
  1113.  
  1114.  
  1115. Class CMDBQualLinkAttr : {OPDBQualLinkAttr CMQualifAssocAttr} {
  1116.     constructor
  1117.     method destructor
  1118.     method prepare
  1119.     method oneGetPrepare
  1120.     method manyGetPrepare
  1121. }
  1122.  
  1123. constructor CMDBQualLinkAttr {class this} {
  1124.     set this [OPDBQualLinkAttr::constructor $class $this]
  1125.     set this [CMQualifAssocAttr::constructor $class $this]
  1126.     # Start constructor user section
  1127.     # End constructor user section
  1128.     return $this
  1129. }
  1130.  
  1131. method CMDBQualLinkAttr::destructor {this} {
  1132.     # Start destructor user section
  1133.     # End destructor user section
  1134.     $this CMQualifAssocAttr::destructor
  1135. }
  1136.  
  1137. selfPromoter OPDBQualLinkAttr {this} {
  1138.     CMDBQualLinkAttr promote $this
  1139. }
  1140.  
  1141. method CMDBQualLinkAttr::prepare {this class model forwhat} {
  1142.     $this prepareForLink $class $model $forwhat
  1143. }
  1144.  
  1145. method CMDBQualLinkAttr::oneGetPrepare {this class model forwhat} {
  1146.     set type [[$this ooplType] getName]
  1147.     set name [$this getName]
  1148.     set keyname [[$this qualifier] getName]
  1149.     set keytype [[[$this qualifier] ooplType] getName]
  1150.     set func_name get[cap "${type}Of[cap $name]"]
  1151.  
  1152.     set op [$class addOperation $func_name $type]
  1153.     $op addParameter $keyname $keytype
  1154.     $this copyAccessMode $op r
  1155. }
  1156.  
  1157. method CMDBQualLinkAttr::manyGetPrepare {this class model forwhat} {
  1158.     set type [[$this ooplType] getName]
  1159.     set name [$this getName]
  1160.     set settype [set_type_name [$this ooplType]]
  1161.     set setname [cap [set_name $name]]
  1162.     set keyname [[$this qualifier] getName]
  1163.     set keytype [[[$this qualifier] ooplType] getName]
  1164.     set func_name get[cap [set_name "${type}Of[cap $name]"]]
  1165.  
  1166.     catch {$model addClass $settype}
  1167.     set op [$class addOperation $func_name int]
  1168.     $op addParameter $setname $settype
  1169.     $op addParameter $keyname $keytype
  1170.     $this copyAccessMode $op r
  1171. }
  1172.  
  1173. # Do not delete this line -- regeneration end marker
  1174.  
  1175. #---------------------------------------------------------------------------
  1176. #      File:           @(#)cmreceived.tcl    /main/titanic/3
  1177. #---------------------------------------------------------------------------
  1178.  
  1179. # Start user added include file section
  1180. # End user added include file section
  1181.  
  1182.  
  1183. Class CMReceivedEvent : {CMCmnEvent OPReceivedEvent} {
  1184.     constructor
  1185.     method destructor
  1186.     method init
  1187.     method checkEventAttributes
  1188.     method checkMethodForEvent
  1189.     method m4Error
  1190.     method asStr
  1191.     attribute longType
  1192.     attribute super
  1193.     attribute accessNeeded
  1194. }
  1195.  
  1196. constructor CMReceivedEvent {class this} {
  1197.     set this [CMCmnEvent::constructor $class $this]
  1198.     set this [OPReceivedEvent::constructor $class $this]
  1199.     $this super 1
  1200.     $this accessNeeded "Public"
  1201.     # Start constructor user section
  1202.     # End constructor user section
  1203.     return $this
  1204. }
  1205.  
  1206. method CMReceivedEvent::destructor {this} {
  1207.     # Start destructor user section
  1208.     # End destructor user section
  1209.     $this CMCmnEvent::destructor
  1210. }
  1211.  
  1212. selfPromoter OPReceivedEvent {this} {
  1213.     set type [$this getEventType]
  1214.     if {$type == "internal_event"} {
  1215.     CMIntEvent promote $this
  1216.     } elseif {$type == "external_event"} {
  1217.     CMExtEvent promote $this
  1218.     } elseif {$type == "event_message"} {
  1219.     CMEventMessage promote $this
  1220.     } elseif {$type == "comm_message"} {
  1221.     CMCommMessage promote $this
  1222.     } elseif {$type == "trace_event"} {
  1223.     CMTraceEvent promote $this
  1224.     }
  1225.     $this init
  1226. }
  1227.  
  1228. method CMReceivedEvent::init {this} {
  1229.     $this super 1
  1230.     $this accessNeeded "Public"
  1231. }
  1232.  
  1233. method CMReceivedEvent::checkEventAttributes {this class} {
  1234. my_debug "CMReceivedEvent::checkEventAttributes()"
  1235.     #
  1236.     # Check if all attributes of this received_event have distinct names.
  1237.     #
  1238.     if {[$this hasAttributes]} {
  1239.     if {![CheckUtil::isUniqueNameList [$this getAttributes]]} {
  1240.         m4_error $E_SAME_EVENT_ATTRIBUTE_NAMES [$this asStr 1] [$class getName]
  1241.     }
  1242.     }
  1243. }
  1244.  
  1245. method CMReceivedEvent::checkMethodForEvent {this class {quiet 0}} {
  1246. my_debug "CMReceivedEvent::checkMethodForEvent()"
  1247.     #
  1248.     # Check for this received_event received by the given class whether
  1249.     # that event is handled by a method of the class.
  1250.     #
  1251.     # For an event to be valid, one of the following must hold:
  1252.     #
  1253.     # - if the received event does not have an associated MGD event,
  1254.     #    an operation with the same name as the event and with the same
  1255.     #    number of parameters as the number of event attributes must exist
  1256.     #    in the class' methods;
  1257.     #
  1258.     # - if the received event does have an associated MGD message, then
  1259.     #    every most decomposed message ("leaf event") in the MGD hierarchy
  1260.     #    with the received event as root, must have one or more parent messages
  1261.     #    for which an operation exists in the class' methods.  This ensures
  1262.     #    that every type of message that can occur, is handled by the class.
  1263.     #
  1264.     set class_name [$class getName]
  1265.     set r_type [$this getEventType]
  1266.     set r_name [$this getName]
  1267.     #
  1268.     # Determine whether we need to consider methods of superclasses,
  1269.     # and the minimum access right for an operation handling the event.
  1270.     #
  1271.     # done in init()
  1272.  
  1273.     #
  1274.     # If this event is sent to the class by the class itself, "Private"
  1275.     # access is all that's needed.  This also takes care of STD
  1276.     # internal_- and external_events.
  1277.     #
  1278.     if {$class_name == [$this getSenderName]} {
  1279.     $this accessNeeded "Private"
  1280.     }
  1281.     set access_needed [$this accessNeeded]
  1282.     set super [$this super]
  1283.  
  1284.     if {[$this hasAttributes]} {
  1285.     set nattrs [llength [$this getAttributes]]
  1286.     } else {
  1287.     set nattrs -1
  1288.     }
  1289.  
  1290.     set e [$this event]  ; # this is a real event (i.e. OPEvent)
  1291.     if {$e == ""} {
  1292.     m4_warning $W_NO_CORR_MSGDEF_FOUND [$this asStr] [$this getSenderName] $class_name
  1293.  
  1294.     # check event
  1295.     #
  1296.     if {$r_name != ""} {
  1297.         set info ""
  1298.         set result [$class findEventMethod $super $r_name $nattrs $access_needed info]
  1299.         if {$result == 1} {
  1300.         if {!$quiet} {
  1301.             $this m4Error E_NO_MATCHING_OPERATION1 $class_name [$this asStr]
  1302.         }
  1303.         return 0
  1304.         } elseif {$result == 2} {
  1305.         if {!$quiet} {
  1306.             $this m4Error E_PARAM_ATTR_MISMATCH1 $class_name [$this asStr] $info $nattrs
  1307.         }
  1308.         return 0
  1309.         } elseif {$result == 3} {
  1310.         if {!$quiet} {
  1311.             $this m4Error E_METHOD_ACCESS1 $class_name [$this asStr] $info $access_needed
  1312.         }
  1313.         return 0
  1314.         }
  1315.     }
  1316.  
  1317. if 0 {
  1318.     # action does not to be a method of the class: NO CHECKING
  1319.  
  1320.     # check action (actions should be objects)
  1321.     #
  1322.     set a_name [$r getAction]
  1323.     if {$a_name != ""} {
  1324.         set nattrs -1
  1325.         regsub {(..ternal_)event} $r_type {\1action} a_type
  1326.         switch -glob $a_type {
  1327.         int*    {set a_long_event_type "Internal STD Action"}
  1328.         default    {set a_long_event_type "External STD Action"}
  1329.         }
  1330.         set info ""
  1331.         set result [$class findEventMethod $super $a_name $nattrs $access_needed info]
  1332.         if {$result == 1} {
  1333.         if {!$quiet} {
  1334.             $this m4Error $a_type E_NO_MATCHING_OPERATION1 $class_name "$a_long_event_type '$action' in [CheckUtil::getDiagram $r]"
  1335.         }
  1336.         return 0
  1337.         } elseif {$result == 2} {
  1338.         if {!$quiet} {
  1339.             $this m4Error $a_type E_PARAM_ATTR_MISMATCH1 $class_name "$a_long_event_type '$action' in [CheckUtil::getDiagram $r]" $info $nattrs
  1340.         }
  1341.         return 0
  1342.         } elseif {$result == 3} {
  1343.         if {!$quiet} {
  1344.             $this m4Error $a_type E_METHOD_ACCESS1 $class_name "$a_long_event_type '$action' in [CheckUtil::Diagram $r]" $info $access_needed
  1345.         }
  1346.         return 0
  1347.         }
  1348.     }
  1349. }  # 0
  1350.  
  1351.     } else {
  1352.     foreach leaf [$e findLeafEvents] {
  1353.         set ok 0
  1354.         set bad_params 0
  1355.         set bad_access 0
  1356.         set name_nparams 0
  1357.         set name_access ""
  1358.         set parents [concat $leaf [$leaf findParentEvents]]
  1359.         foreach parent $parents {
  1360.         set info ""
  1361.         set result [$class findEventMethod $super [$parent getName] $nattrs $access_needed info]
  1362.         if {$result == 0} {
  1363.             set ok 1
  1364.             break
  1365.         } elseif {$result == 2 && !$bad_params} {
  1366.             # remember the first (most derived) event found
  1367.             set bad_params 1
  1368.             set name [$parent getName]
  1369.             set name_nparams $info
  1370.         } elseif {$result == 3 && !$bad_access} {
  1371.             # remember the first (most derived) event found
  1372.             set bad_access 1
  1373.             set name [$parent getName]
  1374.             set name_access $info
  1375.         }
  1376.         }
  1377.         if {!$ok} {
  1378.         set parent_names {}
  1379.         foreach parent $parents {
  1380.             lappend parent_names [$parent getName]
  1381.         }
  1382.         if {!$quiet} {
  1383.             if $bad_params {
  1384.             $this m4Error E_PARAM_ATTR_MISMATCH2 $name $class_name [$this asStr] $name_nparams $nattrs
  1385.             } elseif $bad_access {
  1386.             $this m4Error E_METHOD_ACCESS2 $name $class_name [$this asStr] $name_access $access_needed
  1387.             } else {
  1388.             $this m4Error E_NO_MATCHING_OPERATION2 $class_name [$this asStr] [$leaf asStr] $parent_names
  1389.             }
  1390.         } else {
  1391.                     #
  1392.                     #  No need to continue, since the caller is only interested
  1393.                     #  in the correctness of this event, and here it is clear
  1394.                     #  that it is not correct.
  1395.                     #
  1396.                     return 0
  1397.                 }
  1398.         }
  1399.     }
  1400.     }
  1401.     return 1
  1402. }
  1403.  
  1404. method CMReceivedEvent::m4Error {this errName args} {
  1405.     #
  1406.     # m4_error replacement that constructs an error id based on an error name.
  1407.     # Used to allow for event-specific check configuration.
  1408.     #
  1409.     set err ${errName}_[string toupper [$this getEventType]]
  1410.     eval "m4_error $[get err] $args"
  1411. }
  1412.  
  1413. method CMReceivedEvent::asStr {this {attrs 0} {condact 0}} {
  1414.     #
  1415.     # Create a string describing this event object.
  1416.     # If 'attrs' is 1, the attributes of the event, if present, are added as
  1417.     # well.
  1418.     # If 'condact' is 0, the condition and action, if present, are not added.
  1419.     #
  1420.     set a ""
  1421.     if {$attrs && [$this hasAttributes]} {
  1422.     set first 1
  1423.     foreach n [$this getAttributes] {
  1424.         if {!$first} {
  1425.         append a ", "
  1426.         } else {
  1427.         set first 0
  1428.         }
  1429.         lappend a $n
  1430.     }
  1431.     if {$a == ""} {
  1432.         set a "()"
  1433.     } else {
  1434.         set a "( $a )"
  1435.     }
  1436.     }
  1437.     if {$condact && [$this getEventType] == "external_event"} {
  1438.     set conds [$this getConditions]
  1439.     if {$conds != ""} {
  1440.         set first 1
  1441.         foreach cond $conds {
  1442.         if {!$first} {
  1443.             append a ", "
  1444.         } else {
  1445.             set first 0
  1446.         }
  1447.         append a $cond
  1448.         }
  1449.     }
  1450.     set act [$this getAction]
  1451.     if {$act != ""} {
  1452.         append a {/} $act
  1453.     }
  1454.     }
  1455.     if {$condact && [$this getEventType] == "external_event"} {
  1456.     return "[$this longType] '[$this getName]' in '[$this getName]$a' in [$this getDiagramName].[$this getDiagramType]"
  1457.     }
  1458.     return "[$this longType] '[$this getName]$a' in [$this getDiagramName].[$this getDiagramType]"
  1459. }
  1460.  
  1461. # Do not delete this line -- regeneration end marker
  1462.  
  1463. #---------------------------------------------------------------------------
  1464. #      File:           @(#)cmintevent.tcl    /main/titanic/2
  1465. #---------------------------------------------------------------------------
  1466.  
  1467. # Start user added include file section
  1468. # End user added include file section
  1469.  
  1470.  
  1471.  
  1472. Class CMIntEvent : {CMReceivedEvent} {
  1473.     constructor
  1474.     method destructor
  1475.     method init
  1476.     method mcheck
  1477. }
  1478.  
  1479. constructor CMIntEvent {class this} {
  1480.     set this [CMReceivedEvent::constructor $class $this]
  1481.     # Start constructor user section
  1482.     $this init
  1483.     # End constructor user section
  1484.     return $this
  1485. }
  1486.  
  1487. method CMIntEvent::destructor {this} {
  1488.     # Start destructor user section
  1489.     # End destructor user section
  1490.     $this CMReceivedEvent::destructor
  1491. }
  1492.  
  1493. method CMIntEvent::init {this} {
  1494.     $this longType "Internal STD Event"
  1495.     $this super 0
  1496.     $this accessNeeded "Private"
  1497. }
  1498.  
  1499. method CMIntEvent::mcheck {this class} {
  1500. my_debug "CMIntEvent::mcheck()"
  1501.     $this checkMethodForEvent $class
  1502. }
  1503.  
  1504. # Do not delete this line -- regeneration end marker
  1505.  
  1506. #---------------------------------------------------------------------------
  1507. #      File:           @(#)cmconstruc.tcl    /main/titanic/1
  1508. #---------------------------------------------------------------------------
  1509.  
  1510. # Start user added include file section
  1511. # End user added include file section
  1512.  
  1513.  
  1514. Class CMConstructor : {CMCmnOperation OPConstructor} {
  1515.     constructor
  1516.     method destructor
  1517.     method prepare
  1518. }
  1519.  
  1520. constructor CMConstructor {class this} {
  1521.     set this [CMCmnOperation::constructor $class $this]
  1522.     set this [OPConstructor::constructor $class $this]
  1523.     # Start constructor user section
  1524.     # End constructor user section
  1525.     return $this
  1526. }
  1527.  
  1528. method CMConstructor::destructor {this} {
  1529.     # Start destructor user section
  1530.     # End destructor user section
  1531.     $this CMCmnOperation::destructor
  1532. }
  1533.  
  1534. selfPromoter OPConstructor {this} {
  1535.     CMConstructor promote $this
  1536. }
  1537.  
  1538. method CMConstructor::prepare {this class model forwhat} {
  1539. my_debug "CMConstructor::prepare()"
  1540.     foreach param [$class creationParamSet] {
  1541.     $param prepare $class $model $forwhat
  1542.     }
  1543. }
  1544.  
  1545. # Do not delete this line -- regeneration end marker
  1546.  
  1547. #---------------------------------------------------------------------------
  1548. #      File:           @(#)cmcmnsubje.tcl    /main/titanic/2
  1549. #---------------------------------------------------------------------------
  1550.  
  1551. # Start user added include file section
  1552. # End user added include file section
  1553.  
  1554.  
  1555. Class CMCmnSubject : {CMEventReceiver} {
  1556.     constructor
  1557.     method destructor
  1558.     method prepare
  1559. }
  1560.  
  1561. constructor CMCmnSubject {class this} {
  1562.     set this [CMEventReceiver::constructor $class $this]
  1563.     # Start constructor user section
  1564.     # End constructor user section
  1565.     return $this
  1566. }
  1567.  
  1568. method CMCmnSubject::destructor {this} {
  1569.     # Start destructor user section
  1570.     # End destructor user section
  1571.     $this CMEventReceiver::destructor
  1572. }
  1573.  
  1574. method CMCmnSubject::prepare {this model forwhat} {
  1575. my_debug "CMCmnSubject::prepare()"
  1576.     # empty
  1577. }
  1578.  
  1579. # Do not delete this line -- regeneration end marker
  1580.  
  1581. #---------------------------------------------------------------------------
  1582. #      File:           @(#)cmsubject.tcl    /main/titanic/2
  1583. #---------------------------------------------------------------------------
  1584.  
  1585. # Start user added include file section
  1586. # End user added include file section
  1587.  
  1588.  
  1589. Class CMSubject : {CMCmnSubject OPSubject} {
  1590.     constructor
  1591.     method destructor
  1592.     method mcheck
  1593. }
  1594.  
  1595. constructor CMSubject {class this} {
  1596.     set this [CMCmnSubject::constructor $class $this]
  1597.     set this [OPSubject::constructor $class $this]
  1598.     # Start constructor user section
  1599.     # End constructor user section
  1600.     return $this
  1601. }
  1602.  
  1603. method CMSubject::destructor {this} {
  1604.     # Start destructor user section
  1605.     # End destructor user section
  1606.     $this CMCmnSubject::destructor
  1607. }
  1608.  
  1609. selfPromoter OPSubject {this} {
  1610.     CMSubject promote $this
  1611. }
  1612.  
  1613. method CMSubject::mcheck {this} {
  1614. my_debug "CMSubject::mcheck()"
  1615.     m4_error $E_INVALID_SUBJECT [$this getName] [$this eventDiagram]
  1616. }
  1617.  
  1618. # Do not delete this line -- regeneration end marker
  1619.  
  1620. #---------------------------------------------------------------------------
  1621. #      File:           @(#)cmdbrevers.tcl    /main/titanic/2
  1622. #---------------------------------------------------------------------------
  1623.  
  1624. # Start user added include file section
  1625. # End user added include file section
  1626.  
  1627.  
  1628. Class CMDBReverseLinkAttr : {OPDBReverseLinkAttr CMCmnAssocAttr} {
  1629.     constructor
  1630.     method destructor
  1631.     method prepare
  1632.     method oneGetPrepare
  1633.     method manyGetPrepare
  1634. }
  1635.  
  1636. constructor CMDBReverseLinkAttr {class this} {
  1637.     set this [OPDBReverseLinkAttr::constructor $class $this]
  1638.     set this [CMCmnAssocAttr::constructor $class $this]
  1639.     # Start constructor user section
  1640.     # End constructor user section
  1641.     return $this
  1642. }
  1643.  
  1644. method CMDBReverseLinkAttr::destructor {this} {
  1645.     # Start destructor user section
  1646.     # End destructor user section
  1647.     $this CMCmnAssocAttr::destructor
  1648. }
  1649.  
  1650. selfPromoter OPDBReverseLinkAttr {this} {
  1651.     CMDBReverseLinkAttr promote $this
  1652. }
  1653.  
  1654. method CMDBReverseLinkAttr::prepare {this class model forwhat} {
  1655.     $this prepareForLink $class $model $forwhat
  1656. }
  1657.  
  1658. method CMDBReverseLinkAttr::oneGetPrepare {this class model forwhat} {
  1659.     set type [[$this ooplType] getName]
  1660.     set name [cap [$this getName]]
  1661.  
  1662.     set op [$class addOperation get$name $type]
  1663.     $this copyAccessMode $op r
  1664. }
  1665.  
  1666. method CMDBReverseLinkAttr::manyGetPrepare {this class model forwhat} {
  1667.     # should not occur...
  1668.     puts "ERROR: reverse link attribute '[$this getName]' with multiplicity \
  1669.         'many' in class '[$class getName]'"
  1670. }
  1671.  
  1672. # Do not delete this line -- regeneration end marker
  1673.  
  1674. #---------------------------------------------------------------------------
  1675. #      File:           @(#)cmdatabase.tcl    /main/titanic/2
  1676. #---------------------------------------------------------------------------
  1677.  
  1678. # Start user added include file section
  1679. # End user added include file section
  1680.  
  1681.  
  1682. Class CMDatabaseClass : {CMCmnClass OPDatabaseClass} {
  1683.     constructor
  1684.     method destructor
  1685.     method prepare
  1686. }
  1687.  
  1688. constructor CMDatabaseClass {class this} {
  1689.     set this [CMCmnClass::constructor $class $this]
  1690.     set this [OPDatabaseClass::constructor $class $this]
  1691.     # Start constructor user section
  1692.     # End constructor user section
  1693.     return $this
  1694. }
  1695.  
  1696. method CMDatabaseClass::destructor {this} {
  1697.     # Start destructor user section
  1698.     # End destructor user section
  1699.     $this CMCmnClass::destructor
  1700. }
  1701.  
  1702. selfPromoter OPDatabaseClass {this} {
  1703.     CMDatabaseClass promote $this
  1704. }
  1705.  
  1706. method CMDatabaseClass::prepare {this model forwhat} {
  1707. my_debug "CMDatabaseClass::prepare()"
  1708.     # $this CMClass::prepare ...
  1709.     $this CMCmnClass::prepare $model $forwhat
  1710.     if {$forwhat == "check"} {
  1711.     prepare_db_class $this $model
  1712.     }
  1713. }
  1714.  
  1715. # Do not delete this line -- regeneration end marker
  1716.  
  1717. #---------------------------------------------------------------------------
  1718. #      File:           @(#)cmoperpara.tcl    /main/titanic/1
  1719. #---------------------------------------------------------------------------
  1720.  
  1721. # Start user added include file section
  1722. # End user added include file section
  1723.  
  1724.  
  1725. Class CMOperParameter : {CMParameter OPOperParameter} {
  1726.     constructor
  1727.     method destructor
  1728.     method prepare
  1729. }
  1730.  
  1731. constructor CMOperParameter {class this} {
  1732.     set this [CMParameter::constructor $class $this]
  1733.     set this [OPOperParameter::constructor $class $this]
  1734.     # Start constructor user section
  1735.     # End constructor user section
  1736.     return $this
  1737. }
  1738.  
  1739. method CMOperParameter::destructor {this} {
  1740.     # Start destructor user section
  1741.     # End destructor user section
  1742.     $this CMParameter::destructor
  1743. }
  1744.  
  1745. selfPromoter OPOperParameter {this} {
  1746.     CMOperParameter promote $this
  1747. }
  1748.  
  1749. method CMOperParameter::prepare {this class model forwhat} {
  1750. my_debug "CMOperParameter::prepare()"
  1751.     # empty
  1752. }
  1753.  
  1754. # Do not delete this line -- regeneration end marker
  1755.  
  1756. #---------------------------------------------------------------------------
  1757. #      File:           @(#)cmtypedeft.tcl    /main/titanic/1
  1758. #---------------------------------------------------------------------------
  1759.  
  1760. # Start user added include file section
  1761. # End user added include file section
  1762.  
  1763.  
  1764. Class CMTypeDefType : {OPTypeDefType CMCmnType} {
  1765.     constructor
  1766.     method destructor
  1767. }
  1768.  
  1769. constructor CMTypeDefType {class this} {
  1770.     set this [OPTypeDefType::constructor $class $this]
  1771.     set this [CMCmnType::constructor $class $this]
  1772.     # Start constructor user section
  1773.     # End constructor user section
  1774.     return $this
  1775. }
  1776.  
  1777. method CMTypeDefType::destructor {this} {
  1778.     # Start destructor user section
  1779.     # End destructor user section
  1780.     $this CMCmnType::destructor
  1781. }
  1782.  
  1783. selfPromoter OPTypeDefType {this} {
  1784.     CMTypeDefType promote $this
  1785. }
  1786.  
  1787. # Do not delete this line -- regeneration end marker
  1788.  
  1789. #---------------------------------------------------------------------------
  1790. #      File:           @(#)cmlinkattr.tcl    /main/titanic/1
  1791. #---------------------------------------------------------------------------
  1792.  
  1793. # Start user added include file section
  1794. # End user added include file section
  1795.  
  1796.  
  1797. Class CMLinkAttr : {CMCmnAssocAttr OPLinkAttr} {
  1798.     constructor
  1799.     method destructor
  1800.     method prepare
  1801.     method oneGetPrepare
  1802.     method manyGetPrepare
  1803. }
  1804.  
  1805. constructor CMLinkAttr {class this} {
  1806.     set this [CMCmnAssocAttr::constructor $class $this]
  1807.     set this [OPLinkAttr::constructor $class $this]
  1808.     # Start constructor user section
  1809.     # End constructor user section
  1810.     return $this
  1811. }
  1812.  
  1813. method CMLinkAttr::destructor {this} {
  1814.     # Start destructor user section
  1815.     # End destructor user section
  1816.     $this CMCmnAssocAttr::destructor
  1817. }
  1818.  
  1819. selfPromoter OPLinkAttr {this} {
  1820.     CMLinkAttr promote $this
  1821. }
  1822.  
  1823. method CMLinkAttr::prepare {this class model forwhat} {
  1824. my_debug "CMLinkAttr::prepare()"
  1825.     $this prepareForLink $class $model $forwhat
  1826. }
  1827.  
  1828. method CMLinkAttr::oneGetPrepare {this class model forwhat} {
  1829.     set type [[$this ooplType] getName]
  1830.     set name [cap "${type}Of[cap [$this getName]]"]
  1831.  
  1832.     set op [$class addOperation get$name $type]
  1833.     $this copyAccessMode $op r
  1834. }
  1835.  
  1836. method CMLinkAttr::manyGetPrepare {this class model forwhat} {
  1837.     set ordered [$this isOrdered]
  1838.     set settype [set_type_name [$this ooplType] $ordered]
  1839.     set setname [cap [set_name \
  1840.         "[[$this ooplType] getName]Of[cap [$this getName]]" $ordered]]
  1841.  
  1842.     catch {$model addClass $settype}
  1843.     set op [$class addOperation get$setname $settype]
  1844.     $this copyAccessMode $op r
  1845. }
  1846.  
  1847. # Do not delete this line -- regeneration end marker
  1848.  
  1849. #---------------------------------------------------------------------------
  1850. #      File:           @(#)cmqualasso.tcl    /main/titanic/1
  1851. #---------------------------------------------------------------------------
  1852.  
  1853. # Start user added include file section
  1854. # End user added include file section
  1855.  
  1856.  
  1857. Class CMQualAssocAttr : {CMQualifAssocAttr OPQualAssocAttr} {
  1858.     constructor
  1859.     method destructor
  1860.     method prepare
  1861.     method oneGetPrepare
  1862.     method oneSetPrepare
  1863.     method oneRemovePrepare
  1864.     method manyGetPrepare
  1865.     method manySetPrepare
  1866.     method manyRemovePrepare
  1867. }
  1868.  
  1869. constructor CMQualAssocAttr {class this} {
  1870.     set this [CMQualifAssocAttr::constructor $class $this]
  1871.     set this [OPQualAssocAttr::constructor $class $this]
  1872.     # Start constructor user section
  1873.     # End constructor user section
  1874.     return $this
  1875. }
  1876.  
  1877. method CMQualAssocAttr::destructor {this} {
  1878.     # Start destructor user section
  1879.     # End destructor user section
  1880.     $this CMQualifAssocAttr::destructor
  1881. }
  1882.  
  1883. selfPromoter OPQualAssocAttr {this} {
  1884.     CMQualAssocAttr promote $this
  1885. }
  1886.  
  1887. method CMQualAssocAttr::prepare {this class model forwhat} {
  1888. my_debug "CMQualAssocAttr::prepare()"
  1889.     $this prepareForAssoc $class $model $forwhat
  1890. }
  1891.  
  1892. method CMQualAssocAttr::oneGetPrepare {this class model forwhat} {
  1893.     set type [[$this ooplType] getName]
  1894.     set name [cap [$this getName]]
  1895.     set keyname [[$this qualifier] getName]
  1896.     set keytype [[[$this qualifier] ooplType] getName]
  1897.  
  1898.     set op [$class addOperation get$name $type]
  1899.     $op addParameter $keyname $keytype
  1900.  
  1901.     $this copyAccessMode $op r
  1902. }
  1903.  
  1904. method CMQualAssocAttr::oneSetPrepare {this class model forwhat} {
  1905.     set type [[$this ooplType] getName]
  1906.     set name [cap [$this getName]]
  1907.     set keyname [[$this qualifier] getName]
  1908.     set keytype [[[$this qualifier] ooplType] getName]
  1909.  
  1910.     set op [$class addOperation set$name ""]
  1911.     $op addParameter $keyname $keytype
  1912.     $op addParameter new$name $type
  1913.  
  1914.     $this copyAccessMode $op w
  1915. }
  1916.  
  1917. method CMQualAssocAttr::oneRemovePrepare {this class model forwhat} {
  1918.     set name [cap [$this getName]]
  1919.     set keyname [[$this qualifier] getName]
  1920.     set keytype [[[$this qualifier] ooplType] getName]
  1921.  
  1922.     set op [$class addOperation remove$name ""]
  1923.     $op addParameter $keyname $keytype
  1924.  
  1925.     $this copyAccessMode $op w
  1926. }
  1927.  
  1928. method CMQualAssocAttr::manyGetPrepare {this class model forwhat} {
  1929.     set settype [set_type_name [$this ooplType] [$this isOrdered]]
  1930.     set setname [cap [$this getName]]
  1931.     set keyname [[$this qualifier] getName]
  1932.     set keytype [[[$this qualifier] ooplType] getName]
  1933.  
  1934.     catch {$model addClass $settype}
  1935.  
  1936.     set op [$class addOperation get$setname $settype]
  1937.     $op addParameter $keyname $keytype
  1938.  
  1939.     $this copyAccessMode $op r
  1940. }
  1941.  
  1942. method CMQualAssocAttr::manySetPrepare {this class model forwhat} {
  1943.     set type [[$this ooplType] getName]
  1944.     set name [cap [$this getName]]
  1945.     set keyname [[$this qualifier] getName]
  1946.     set keytype [[[$this qualifier] ooplType] getName]
  1947.  
  1948.     set op [$class addOperation add$name ""]
  1949.     $op addParameter $keyname $keytype
  1950.     $op addParameter new$name $type
  1951.  
  1952.     $this copyAccessMode $op w
  1953. }
  1954.  
  1955. method CMQualAssocAttr::manyRemovePrepare {this class model forwhat} {
  1956.     set type [[$this ooplType] getName]
  1957.     set name [cap [$this getName]]
  1958.     set keyname [[$this qualifier] getName]
  1959.     set keytype [[[$this qualifier] ooplType] getName]
  1960.  
  1961.     set op [$class addOperation remove$name ""]
  1962.     $op addParameter $keyname $keytype
  1963.     $op addParameter old$name $type
  1964.  
  1965.     $this copyAccessMode $op w
  1966. }
  1967.  
  1968. # Do not delete this line -- regeneration end marker
  1969.  
  1970. #---------------------------------------------------------------------------
  1971. #      File:           @(#)cmbdataatt.tcl    /main/titanic/1
  1972. #---------------------------------------------------------------------------
  1973.  
  1974. # Start user added include file section
  1975. # End user added include file section
  1976.  
  1977.  
  1978. Class CMbDataAttr : {CMCmnAttr} {
  1979.     constructor
  1980.     method destructor
  1981.     method mcheck
  1982.     method getAccessMode
  1983. }
  1984.  
  1985. constructor CMbDataAttr {class this} {
  1986.     set this [CMCmnAttr::constructor $class $this]
  1987.     # Start constructor user section
  1988.     # End constructor user section
  1989.     return $this
  1990. }
  1991.  
  1992. method CMbDataAttr::destructor {this} {
  1993.     # Start destructor user section
  1994.     # End destructor user section
  1995.     $this CMCmnAttr::destructor
  1996. }
  1997.  
  1998. method CMbDataAttr::mcheck {this class} {
  1999. my_debug "CMbDataAttr::mcheck()"
  2000.     # empty
  2001. }
  2002.  
  2003. method CMbDataAttr::getAccessMode {this} {
  2004.     return [$this getPropertyValue attrib_access]
  2005. }
  2006.  
  2007. # Do not delete this line -- regeneration end marker
  2008.  
  2009. #---------------------------------------------------------------------------
  2010. #      File:           @(#)cmextevent.tcl    /main/titanic/2
  2011. #---------------------------------------------------------------------------
  2012.  
  2013. # Start user added include file section
  2014. # End user added include file section
  2015.  
  2016.  
  2017.  
  2018. Class CMExtEvent : {CMReceivedEvent} {
  2019.     constructor
  2020.     method destructor
  2021.     method init
  2022.     method mcheck
  2023. }
  2024.  
  2025. constructor CMExtEvent {class this} {
  2026.     set this [CMReceivedEvent::constructor $class $this]
  2027.     # Start constructor user section
  2028.     $this init
  2029.     # End constructor user section
  2030.     return $this
  2031. }
  2032.  
  2033. method CMExtEvent::destructor {this} {
  2034.     # Start destructor user section
  2035.     # End destructor user section
  2036.     $this CMReceivedEvent::destructor
  2037. }
  2038.  
  2039. method CMExtEvent::init {this} {
  2040.     $this longType "External STD Event"
  2041.     $this CMReceivedEvent::init
  2042. }
  2043.  
  2044. method CMExtEvent::mcheck {this class} {
  2045. my_debug "CMExtEvent::mcheck()"
  2046.     $this checkEventAttributes $class
  2047.     $this checkMethodForEvent $class
  2048. }
  2049.  
  2050. # Do not delete this line -- regeneration end marker
  2051.  
  2052. #---------------------------------------------------------------------------
  2053. #      File:           @(#)cmoperatio.tcl    /main/titanic/1
  2054. #---------------------------------------------------------------------------
  2055.  
  2056. # Start user added include file section
  2057. # End user added include file section
  2058.  
  2059.  
  2060. Class CMOperation : {CMCmnOperation OPOperation} {
  2061.     constructor
  2062.     method destructor
  2063.     method prepare
  2064.     method checkAccess
  2065. }
  2066.  
  2067. constructor CMOperation {class this} {
  2068.     set this [CMCmnOperation::constructor $class $this]
  2069.     set this [OPOperation::constructor $class $this]
  2070.     # Start constructor user section
  2071.     # End constructor user section
  2072.     return $this
  2073. }
  2074.  
  2075. method CMOperation::destructor {this} {
  2076.     # Start destructor user section
  2077.     # End destructor user section
  2078.     $this CMCmnOperation::destructor
  2079. }
  2080.  
  2081. selfPromoter OPOperation {this} {
  2082.     CMOperation promote $this
  2083. }
  2084.  
  2085. method CMOperation::prepare {this class model forwhat} {
  2086. my_debug "CMOperation::prepare()"
  2087.     foreach param [get_parameters $this] {
  2088.     $param prepare $class $model $forwhat
  2089.     }
  2090. }
  2091.  
  2092. method CMOperation::checkAccess {this needed} {
  2093. my_debug "CMOperation::checkAccess()"
  2094.     #
  2095.     # Given an access right string ("Private", "Protected",
  2096.     # "Public", or "" as synonym for "Public", return whether this operation
  2097.     # can be called.
  2098.     #
  2099.     set access [$this getPropertyValue method_access]
  2100.     switch $needed {
  2101.         "Private"
  2102.             {if {$access == "None"} {
  2103.                 return 0
  2104.             } else {
  2105.                 return 1
  2106.             }}
  2107.         "Protected"
  2108.             {if {$access == "Private" || $access == "None"} {
  2109.                 return 0
  2110.             } else {
  2111.                 return 1
  2112.             }}
  2113.         "Public"
  2114.             {if {$access == "Private" || $access == "Protected" || $access == "None"} {
  2115.                 return 0
  2116.             else
  2117.                 return 1
  2118.             }}
  2119.     }
  2120.     return 1
  2121. }
  2122.  
  2123. # Do not delete this line -- regeneration end marker
  2124.  
  2125. #---------------------------------------------------------------------------
  2126. #      File:           @(#)cmevent.tcl    /main/titanic/2
  2127. #---------------------------------------------------------------------------
  2128.  
  2129. # Start user added include file section
  2130. # End user added include file section
  2131.  
  2132.  
  2133.  
  2134. Class CMEvent : {CMCmnEvent OPEvent} {
  2135.     constructor
  2136.     method destructor
  2137.     method findLeafEvents
  2138.     method findParentEvents
  2139.     method asStr
  2140. }
  2141.  
  2142. constructor CMEvent {class this} {
  2143.     set this [CMCmnEvent::constructor $class $this]
  2144.     set this [OPEvent::constructor $class $this]
  2145.     # Start constructor user section
  2146.     # End constructor user section
  2147.     return $this
  2148. }
  2149.  
  2150. method CMEvent::destructor {this} {
  2151.     # Start destructor user section
  2152.     # End destructor user section
  2153.     $this CMCmnEvent::destructor
  2154. }
  2155.  
  2156. selfPromoter OPEvent {this} {
  2157.     CMEvent promote $this
  2158. }
  2159.  
  2160. method CMEvent::findLeafEvents {this} {
  2161.     #
  2162.     # Return a list with all Event objects that are leaves of the event
  2163.     # hierarchy with this event as root.
  2164.     #
  2165.     set leafs {}
  2166.     foreach n [$this childEventSet] {
  2167.     eval "lappend leafs [$n findLeafEvents]"
  2168.     }
  2169.  
  2170.     # if no decompositions, this event is a leaf event
  2171.     if {$leafs == {}} {
  2172.     lappend leafs $this
  2173.     }
  2174.  
  2175.     return $leafs
  2176. }
  2177.  
  2178. method CMEvent::findParentEvents {this} {
  2179.     #
  2180.     # Return a list with all parent events of this event
  2181.     #
  2182.     set parents {}
  2183.  
  2184.     set parent [$this parentEvent]
  2185.  
  2186.     while {$parent != ""} {
  2187.     lappend parents $parent
  2188.     set parent [$parent parentEvent]
  2189.     }
  2190.  
  2191.     return $parents
  2192. }
  2193.  
  2194. method CMEvent::asStr {this {attrs 0} {condact 0}} {
  2195.     return "MGD Message '[$this getName]' in [$this getDiagramName].[$this getDiagramType]"
  2196. }
  2197.  
  2198. # Do not delete this line -- regeneration end marker
  2199.  
  2200. #---------------------------------------------------------------------------
  2201. #      File:           @(#)cmdiagsubj.tcl    /main/titanic/3
  2202. #---------------------------------------------------------------------------
  2203.  
  2204. # Start user added include file section
  2205. # End user added include file section
  2206.  
  2207.  
  2208. Class CMDiagSubject : {CMCmnSubject} {
  2209.     constructor
  2210.     method destructor
  2211.     method cadCheck
  2212.     method ccdCheck
  2213. }
  2214.  
  2215. constructor CMDiagSubject {class this} {
  2216.     set this [CMCmnSubject::constructor $class $this]
  2217.     # Start constructor user section
  2218.     # End constructor user section
  2219.     return $this
  2220. }
  2221.  
  2222. method CMDiagSubject::destructor {this} {
  2223.     # Start destructor user section
  2224.     # End destructor user section
  2225.     $this CMCmnSubject::destructor
  2226. }
  2227.  
  2228. method CMDiagSubject::cadCheck {this} {
  2229.     #
  2230.     #  Check if each received event of this subject is handled by one of
  2231.     #  the classes in this CAD.
  2232.     #
  2233.     if {[M4CheckManager::errorControl $E_NO_MATCHING_OPER_IN_SUBJECT] == "off"} {
  2234.         return
  2235.     }
  2236.  
  2237.     set subjectName [$this getName]
  2238.     set subjectType [$this get_obj_type]
  2239.     set diagramName "[$this getDiagramName].[$this getDiagramType]"
  2240.  
  2241.     #
  2242.     #  Load and prepare the model for all classes in the diagram and
  2243.     #  check for every event received by this subject whether it is
  2244.     #  handled by some class.
  2245.     #
  2246.     if {[catch {set classes [get_diagram_classes $subjectName cad]} msg]} {
  2247.         puts stdout $msg
  2248.         return
  2249.     }
  2250.     if {[lempty $classes]} {
  2251.         m4_error $E_SUBJECT_IS_EMPTY CD $subjectName $diagramName
  2252.         return
  2253.     }
  2254.  
  2255.     set modelChecker [ModelChecker new $classes ccd]
  2256.     $modelChecker loadModel 0 1 0
  2257.     if {[$modelChecker ooModel] == ""} {
  2258.         m4_message $M_LOADING_MODEL_FAILED $subjectType $subjectName
  2259.         return
  2260.     }
  2261.     [$modelChecker ooplModel] prepare [$modelChecker ooplClasses] [$modelChecker ooplSubjects] check
  2262.  
  2263.     foreach recvEv [$this getReceivedEvents] {
  2264.     set found 0
  2265.     foreach class [$modelChecker ooplClasses] {
  2266.             if {[$recvEv checkMethodForEvent $class "" 1]} {
  2267.                 set found 1
  2268.                 break
  2269.             }
  2270.     }
  2271.         if {!$found} {
  2272.             m4_error $E_NO_MATCHING_OPER_IN_SUBJECT CD $subjectName [$recvEv asStr]
  2273.         }
  2274.     }
  2275.  
  2276.     [$modelChecker ooModel] delete
  2277. }
  2278.  
  2279. method CMDiagSubject::ccdCheck {this} {
  2280.     #
  2281.     #  Check if each received event of this subject is received by one of the
  2282.     #  classes in the CCD specified by this subject.  This CCD should exist in
  2283.     #  the current system.
  2284.     #
  2285.     #  This function assumes that all classes occurring in the CCD have been
  2286.     #  loaded in the current oopl model.
  2287.     #
  2288.     if {[M4CheckManager::errorControl $E_NO_MATCHING_OPER_IN_SUBJECT] == "off"} {
  2289.         return
  2290.     }
  2291.  
  2292.     set subjectName [$this getName]
  2293.     set subjectType [$this get_obj_type]
  2294.     set diagramName "[$this getDiagramName].[$this getDiagramType]"
  2295.  
  2296.     if {[catch {set classes [get_diagram_classes $subjectName ccd]} msg]} {
  2297.         puts stdout $msg
  2298.         return
  2299.     }
  2300.  
  2301.     foreach recvEv [$this getReceivedEvents] {
  2302.         set name [$recvEv getName]
  2303.         set found 0
  2304.         foreach class $classes {
  2305.             set ooplClass [$ooplmodel findClass $class]
  2306.             if {$ooplClass != ""} {
  2307.                 foreach recvEv2 [$ooplClass getReceivedEvents] {
  2308.                     if {$name == [$recvEv2 getName]} {
  2309.                         set found 1
  2310.                         break
  2311.                     }
  2312.                 }
  2313.             }
  2314.             if {$found} {
  2315.                 break
  2316.             }
  2317.         }
  2318.         if {!$found} {
  2319.             m4_error $E_NO_MATCHING_MSG_IN_SUBJECT $recvEvName $subjectName $diagramName
  2320.         }
  2321.     }
  2322. }
  2323.  
  2324. # Do not delete this line -- regeneration end marker
  2325.  
  2326. #---------------------------------------------------------------------------
  2327. #      File:           @(#)cmccdsubje.tcl    /main/titanic/2
  2328. #---------------------------------------------------------------------------
  2329.  
  2330. # Start user added include file section
  2331. # End user added include file section
  2332.  
  2333.  
  2334. Class CMCCDSubject : {CMDiagSubject OPCCDSubject} {
  2335.     constructor
  2336.     method destructor
  2337.     method mcheck
  2338. }
  2339.  
  2340. constructor CMCCDSubject {class this} {
  2341.     set this [CMDiagSubject::constructor $class $this]
  2342.     set this [OPCCDSubject::constructor $class $this]
  2343.     # Start constructor user section
  2344.     # End constructor user section
  2345.     return $this
  2346. }
  2347.  
  2348. method CMCCDSubject::destructor {this} {
  2349.     # Start destructor user section
  2350.     # End destructor user section
  2351.     $this CMDiagSubject::destructor
  2352. }
  2353.  
  2354. selfPromoter OPCCDSubject {this} {
  2355.     CMCCDSubject promote $this
  2356. }
  2357.  
  2358. method CMCCDSubject::mcheck {this} {
  2359. my_debug "CMCCDSubject::mcheck()"
  2360.     $this ccdCheck
  2361. }
  2362.  
  2363. # Do not delete this line -- regeneration end marker
  2364.  
  2365. #---------------------------------------------------------------------------
  2366. #      File:           @(#)cmquallink.tcl    /main/titanic/1
  2367. #---------------------------------------------------------------------------
  2368.  
  2369. # Start user added include file section
  2370. # End user added include file section
  2371.  
  2372.  
  2373. Class CMQualLinkAttr : {OPQualLinkAttr CMQualifAssocAttr} {
  2374.     constructor
  2375.     method destructor
  2376.     method prepare
  2377.     method oneGetPrepare
  2378.     method manyGetPrepare
  2379. }
  2380.  
  2381. constructor CMQualLinkAttr {class this} {
  2382.     set this [OPQualLinkAttr::constructor $class $this]
  2383.     set this [CMQualifAssocAttr::constructor $class $this]
  2384.     # Start constructor user section
  2385.     # End constructor user section
  2386.     return $this
  2387. }
  2388.  
  2389. method CMQualLinkAttr::destructor {this} {
  2390.     # Start destructor user section
  2391.     # End destructor user section
  2392.     $this CMQualifAssocAttr::destructor
  2393. }
  2394.  
  2395. selfPromoter OPQualLinkAttr {this} {
  2396.     CMQualLinkAttr promote $this
  2397. }
  2398.  
  2399. method CMQualLinkAttr::prepare {this class model forwhat} {
  2400. my_debug "CMQualLinkAttr::prepare()"
  2401.     $this prepareForLink $class $model $forwhat
  2402. }
  2403.  
  2404. method CMQualLinkAttr::oneGetPrepare {this class model forwhat} {
  2405.     set type [[$this ooplType] getName]
  2406.     set name [cap [[$this ooplType] getName]Of[cap [$this getName]]]
  2407.     set keyname [[$this qualifier] getName]
  2408.     set keytype [[[$this qualifier] ooplType] getName]
  2409.  
  2410.     set op [$class addOperation get$name $type]
  2411.     $op addParameter $keyname $keytype
  2412.  
  2413.     $this copyAccessMode $op r
  2414. }
  2415.  
  2416. method CMQualLinkAttr::manyGetPrepare {this class model forwhat} {
  2417.     set settype [set_type_name [$this ooplType] [$this isOrdered]]
  2418.     set setname [cap [[$this ooplType] getName]Of[cap [$this getName]]]
  2419.     set keyname [ [$this qualifier] getName]
  2420.     set keytype [[[$this qualifier] ooplType] getName]
  2421.  
  2422.     catch {$model addClass $settype}
  2423.     set op [$class addOperation get$setname $settype]
  2424.     $op addParameter $keyname $keytype
  2425.  
  2426.     $this copyAccessMode $op r
  2427. }
  2428.  
  2429. # Do not delete this line -- regeneration end marker
  2430.  
  2431. #---------------------------------------------------------------------------
  2432. #      File:           @(#)cmbasetype.tcl    /main/titanic/1
  2433. #---------------------------------------------------------------------------
  2434.  
  2435. # Start user added include file section
  2436. # End user added include file section
  2437.  
  2438.  
  2439. Class CMBaseType : {CMCmnType OPBaseType} {
  2440.     constructor
  2441.     method destructor
  2442. }
  2443.  
  2444. constructor CMBaseType {class this} {
  2445.     set this [CMCmnType::constructor $class $this]
  2446.     set this [OPBaseType::constructor $class $this]
  2447.     # Start constructor user section
  2448.     # End constructor user section
  2449.     return $this
  2450. }
  2451.  
  2452. method CMBaseType::destructor {this} {
  2453.     # Start destructor user section
  2454.     # End destructor user section
  2455.     $this CMCmnType::destructor
  2456. }
  2457.  
  2458. selfPromoter OPBaseType {this} {
  2459.     CMBaseType promote $this
  2460. }
  2461.  
  2462. # Do not delete this line -- regeneration end marker
  2463.  
  2464. #---------------------------------------------------------------------------
  2465. #      File:           @(#)cmclass.tcl    /main/titanic/1
  2466. #---------------------------------------------------------------------------
  2467.  
  2468. # Start user added include file section
  2469. # End user added include file section
  2470.  
  2471.  
  2472. Class CMClass : {CMCmnClass OPClass} {
  2473.     constructor
  2474.     method destructor
  2475. }
  2476.  
  2477. constructor CMClass {class this} {
  2478.     set this [CMCmnClass::constructor $class $this]
  2479.     set this [OPClass::constructor $class $this]
  2480.     # Start constructor user section
  2481.     # End constructor user section
  2482.     return $this
  2483. }
  2484.  
  2485. method CMClass::destructor {this} {
  2486.     # Start destructor user section
  2487.     # End destructor user section
  2488.     $this CMCmnClass::destructor
  2489. }
  2490.  
  2491. selfPromoter OPClass {this} {
  2492.     CMClass promote $this
  2493. }
  2494.  
  2495. # Do not delete this line -- regeneration end marker
  2496.  
  2497. #---------------------------------------------------------------------------
  2498. #      File:           @(#)cmlinkclas.tcl    /main/titanic/1
  2499. #---------------------------------------------------------------------------
  2500.  
  2501. # Start user added include file section
  2502. # End user added include file section
  2503.  
  2504.  
  2505. Class CMLinkClass : {CMCmnClass OPLinkClass} {
  2506.     constructor
  2507.     method destructor
  2508. }
  2509.  
  2510. constructor CMLinkClass {class this} {
  2511.     set this [CMCmnClass::constructor $class $this]
  2512.     set this [OPLinkClass::constructor $class $this]
  2513.     # Start constructor user section
  2514.     # End constructor user section
  2515.     return $this
  2516. }
  2517.  
  2518. method CMLinkClass::destructor {this} {
  2519.     # Start destructor user section
  2520.     # End destructor user section
  2521.     $this CMCmnClass::destructor
  2522. }
  2523.  
  2524. selfPromoter OPLinkClass {this} {
  2525.     CMLinkClass promote $this
  2526. }
  2527.  
  2528. # Do not delete this line -- regeneration end marker
  2529.  
  2530. #---------------------------------------------------------------------------
  2531. #      File:           @(#)cmclassenu.tcl    /main/titanic/1
  2532. #---------------------------------------------------------------------------
  2533.  
  2534. # Start user added include file section
  2535. # End user added include file section
  2536.  
  2537.  
  2538. Class CMClassEnum : {CMSpecialClass OPClassEnum} {
  2539.     constructor
  2540.     method destructor
  2541. }
  2542.  
  2543. constructor CMClassEnum {class this} {
  2544.     set this [CMSpecialClass::constructor $class $this]
  2545.     set this [OPClassEnum::constructor $class $this]
  2546.     # Start constructor user section
  2547.     # End constructor user section
  2548.     return $this
  2549. }
  2550.  
  2551. method CMClassEnum::destructor {this} {
  2552.     # Start destructor user section
  2553.     # End destructor user section
  2554.     $this CMSpecialClass::destructor
  2555. }
  2556.  
  2557. selfPromoter OPClassEnum {this} {
  2558.     CMClassEnum promote $this
  2559. }
  2560.  
  2561. # Do not delete this line -- regeneration end marker
  2562.  
  2563. #---------------------------------------------------------------------------
  2564. #      File:           @(#)cmdbqualas.tcl    /main/titanic/1
  2565. #---------------------------------------------------------------------------
  2566.  
  2567. # Start user added include file section
  2568. # End user added include file section
  2569.  
  2570.  
  2571. Class CMDBQualAssocAttr : {CMQualifAssocAttr OPDBQualAssocAttr} {
  2572.     constructor
  2573.     method destructor
  2574.     method prepare
  2575.     method oneGetPrepare
  2576.     method oneSetPrepare
  2577.     method oneRemovePrepare
  2578.     method manyGetPrepare
  2579.     method manySetPrepare
  2580.     method manyRemovePrepare
  2581.     method anySetPrepare
  2582. }
  2583.  
  2584. constructor CMDBQualAssocAttr {class this} {
  2585.     set this [CMQualifAssocAttr::constructor $class $this]
  2586.     set this [OPDBQualAssocAttr::constructor $class $this]
  2587.     # Start constructor user section
  2588.     # End constructor user section
  2589.     return $this
  2590. }
  2591.  
  2592. method CMDBQualAssocAttr::destructor {this} {
  2593.     # Start destructor user section
  2594.     # End destructor user section
  2595.     $this CMQualifAssocAttr::destructor
  2596. }
  2597.  
  2598. selfPromoter OPDBQualAssocAttr {this} {
  2599.     CMDBQualAssocAttr promote $this
  2600. }
  2601.  
  2602. method CMDBQualAssocAttr::prepare {this class model forwhat} {
  2603. my_debug "CMDBQualAssocAttr::prepare()"
  2604.     $this prepareForAssoc $class $model $forwhat
  2605. }
  2606.  
  2607. method CMDBQualAssocAttr::oneGetPrepare {this class model forwhat} {
  2608.     set type [[$this ooplType] getName]
  2609.     set name [$this getName]
  2610.     set keyname [[$this qualifier] getName]
  2611.     set keytype [[[$this qualifier] ooplType] getName]
  2612.  
  2613.     set op [$class addOperation "get[cap $name]" $type]
  2614.     $op addParameter $keyname $keytype
  2615.     $this copyAccessMode $op r
  2616. }
  2617.  
  2618. method CMDBQualAssocAttr::oneSetPrepare {this class model forwhat} {
  2619.     $this anySetPrepare $class $model $forwhat "set"
  2620. }
  2621.  
  2622. method CMDBQualAssocAttr::oneRemovePrepare {this class model forwhat} {
  2623.     set name [cap [$this getName]]
  2624.     set keyname [[$this qualifier] getName]
  2625.     set keytype [[[$this qualifier] ooplType] getName]
  2626.  
  2627.     set op [$class addOperation remove$name int]
  2628.     $op addParameter $keyname $keytype
  2629.     $this copyAccessMode $op w
  2630. }
  2631.  
  2632. method CMDBQualAssocAttr::manyGetPrepare {this class model forwhat} {
  2633.     set name [$this getName]
  2634.     set settype [set_type_name [$this ooplType]]
  2635.     set setname [cap [set_name $name]]
  2636.     set keyname [[$this qualifier] getName]
  2637.     set keytype [[[$this qualifier] ooplType] getName]
  2638.  
  2639.     catch {$model addClass $settype}
  2640.     set op [$class addOperation get$setname int]
  2641.     $op addParameter $setname $settype
  2642.     $op addParameter $keyname $keytype
  2643.     $this copyAccessMode $op r
  2644. }
  2645.  
  2646. method CMDBQualAssocAttr::manySetPrepare {this class model forwhat} {
  2647.     $this anySetPrepare $class $model $forwhat "add"
  2648. }
  2649.  
  2650. method CMDBQualAssocAttr::manyRemovePrepare {this class model forwhat} {
  2651.     set type [[$this ooplType] getName]
  2652.     set name [cap [$this getName]]
  2653.     set keyname [[$this qualifier] getName]
  2654.     set keytype [[[$this qualifier] ooplType] getName]
  2655.  
  2656.     set op [$class addOperation remove$name int]
  2657.     $op addParameter $keyname $keytype
  2658.     $op addParameter toRemove $type
  2659.     $this copyAccessMode $op w
  2660. }
  2661.  
  2662. method CMDBQualAssocAttr::anySetPrepare {this class model forwhat prefix} {
  2663.     set type [[$this ooplType] getName]
  2664.     set name [cap [$this getName]]
  2665.     set keyname [[$this qualifier] getName]
  2666.     set keytype [[[$this qualifier] ooplType] getName]
  2667.  
  2668.     set op [$class addOperation $prefix$name int]
  2669.     $op addParameter $keyname $keytype
  2670.     $op addParameter new$name $type
  2671.     $this copyAccessMode $op w
  2672. }
  2673.  
  2674. # Do not delete this line -- regeneration end marker
  2675.  
  2676. #---------------------------------------------------------------------------
  2677. #      File:           @(#)cmdataattr.tcl    /main/titanic/1
  2678. #---------------------------------------------------------------------------
  2679.  
  2680. # Start user added include file section
  2681. # End user added include file section
  2682.  
  2683.  
  2684. Class CMDataAttr : {CMbDataAttr OPDataAttr} {
  2685.     constructor
  2686.     method destructor
  2687.     method prepare
  2688. }
  2689.  
  2690. constructor CMDataAttr {class this} {
  2691.     set this [CMbDataAttr::constructor $class $this]
  2692.     set this [OPDataAttr::constructor $class $this]
  2693.     # Start constructor user section
  2694.     # End constructor user section
  2695.     return $this
  2696. }
  2697.  
  2698. method CMDataAttr::destructor {this} {
  2699.     # Start destructor user section
  2700.     # End destructor user section
  2701.     $this CMbDataAttr::destructor
  2702. }
  2703.  
  2704. selfPromoter OPDataAttr {this} {
  2705.     CMDataAttr promote $this
  2706. }
  2707.  
  2708. method CMDataAttr::prepare {this class model forwhat} {
  2709. my_debug "CMDataAttr::prepare()"
  2710.     set mdf [$this getPropertyValue modifier]
  2711.     if {$mdf != "" && $mdf != "Default"} {
  2712.         # when a modifier is specified
  2713.         # do not generate access funcs
  2714.         return
  2715.     }
  2716.  
  2717.     set name [cap [$this getName]]
  2718.     set type [[$this ooplType] getName]
  2719.  
  2720.     set op [$class addOperation get$name $type]
  2721.     $this copyAccessMode $op r
  2722.  
  2723.     set op [$class addOperation set$name ""]
  2724.     $op addParameter new$name $type
  2725.  
  2726.     $this copyAccessMode $op w
  2727. }
  2728.  
  2729. # Do not delete this line -- regeneration end marker
  2730.  
  2731. #---------------------------------------------------------------------------
  2732. #      File:           @(#)cmclasstde.tcl    /main/titanic/1
  2733. #---------------------------------------------------------------------------
  2734.  
  2735. # Start user added include file section
  2736. # End user added include file section
  2737.  
  2738.  
  2739. Class CMClassTDef : {CMSpecialClass OPClassTDef} {
  2740.     constructor
  2741.     method destructor
  2742. }
  2743.  
  2744. constructor CMClassTDef {class this} {
  2745.     set this [CMSpecialClass::constructor $class $this]
  2746.     set this [OPClassTDef::constructor $class $this]
  2747.     # Start constructor user section
  2748.     # End constructor user section
  2749.     return $this
  2750. }
  2751.  
  2752. method CMClassTDef::destructor {this} {
  2753.     # Start destructor user section
  2754.     # End destructor user section
  2755.     $this CMSpecialClass::destructor
  2756. }
  2757.  
  2758. selfPromoter OPClassTDef {this} {
  2759.     CMClassTDef promote $this
  2760. }
  2761.  
  2762. # Do not delete this line -- regeneration end marker
  2763.  
  2764. #---------------------------------------------------------------------------
  2765. #      File:           @(#)cmtraceeve.tcl    /main/titanic/3
  2766. #---------------------------------------------------------------------------
  2767.  
  2768. # Start user added include file section
  2769. # End user added include file section
  2770.  
  2771.  
  2772.  
  2773. Class CMTraceEvent : {CMReceivedEvent} {
  2774.     constructor
  2775.     method destructor
  2776.     method init
  2777.     method mcheck
  2778.     method checkCorrCcdMessage
  2779.     method checkEtdTimes
  2780. }
  2781.  
  2782. constructor CMTraceEvent {class this} {
  2783.     set this [CMReceivedEvent::constructor $class $this]
  2784.     # Start constructor user section
  2785.     $this init
  2786.     # End constructor user section
  2787.     return $this
  2788. }
  2789.  
  2790. method CMTraceEvent::destructor {this} {
  2791.     # Start destructor user section
  2792.     # End destructor user section
  2793.     $this CMReceivedEvent::destructor
  2794. }
  2795.  
  2796. method CMTraceEvent::init {this} {
  2797.     $this longType "SD Message"
  2798.     $this CMReceivedEvent::init
  2799. }
  2800.  
  2801. method CMTraceEvent::mcheck {this class} {
  2802. my_debug "CMTraceEvent::mcheck()"
  2803.     $this checkEventAttributes $class
  2804.     $this checkCorrCcdMessage $class
  2805.     $this checkEtdTimes $class
  2806.     $this checkMethodForEvent $class
  2807. }
  2808.  
  2809. method CMTraceEvent::checkCorrCcdMessage {this class} {
  2810. my_debug "CMTraceEvent::checkCorrCcdMessage()"
  2811.     #
  2812.     # Check to see if this trace_event occurs as any comm_message to the
  2813.     # same class as the trace_event in any CCD in the system.
  2814.     #
  2815.     # This function assumes that the comm_message events are loaded in the
  2816.     # ooplmodel (i.e. that "ccd" was passed to option "-events").
  2817.     #
  2818.     if {[M4CheckManager::errorControl $E_NO_CORR_CCDMSG_FOUND] == "off"} {
  2819.         return
  2820.     }
  2821.  
  2822.     set r_name [$this getName]
  2823.     set r_found 0
  2824.  
  2825.     foreach ccd_r [$class getReceivedEvents] {
  2826.     if {[$ccd_r getEventType] == "comm_message" && [$ccd_r getName] == $r_name} {
  2827.         set r_found 1
  2828.         break
  2829.     }
  2830.     }
  2831.  
  2832.     if {!$r_found} {
  2833.     m4_warning $E_NO_CORR_CCDMSG_FOUND [$this asStr] \
  2834.            [$this getSenderName] [$class getName]
  2835.     }
  2836. }
  2837.  
  2838. method CMTraceEvent::checkEtdTimes {this class} {
  2839. my_debug "CMTraceEvent::checkEtdTimes()"
  2840.     #
  2841.     # If this event has the receiving object as the sending object, check
  2842.     # if the arrival time is later than the send time.
  2843.     #
  2844.  
  2845.     #
  2846.     # Does not work, for two reasons:
  2847.     # 1) save diagram does not update begin_y/end_y when stripping diagram,
  2848.     #    so that only coordinates of first connector are saved (if intermediate
  2849.     #    vertices are used)
  2850.     # 2) given class may have two distinct 'timelines' in the same
  2851.     #    diagram, and the event may be sent from one to the other,
  2852.     #    making it invalid to compare src and dst times
  2853.     # This check is better done in libetd.
  2854.     #
  2855.     if 0 {
  2856.     if {[$this getSenderName] == [$class getName]} {
  2857.         if {[get_dst_time $this] < [get_src_time $this]} {
  2858.         m4_error $E_RECEIVED_BEFORE_SENT \
  2859.             [$class getName] [$this asStr]
  2860.         }
  2861.     }
  2862.     }  # 0
  2863. }
  2864.  
  2865. # Do not delete this line -- regeneration end marker
  2866.  
  2867. #---------------------------------------------------------------------------
  2868. #      File:           @(#)cmclasstyp.tcl    /main/titanic/1
  2869. #---------------------------------------------------------------------------
  2870.  
  2871. # Start user added include file section
  2872. # End user added include file section
  2873.  
  2874.  
  2875. Class CMClassType : {CMCmnType OPClassType} {
  2876.     constructor
  2877.     method destructor
  2878. }
  2879.  
  2880. constructor CMClassType {class this} {
  2881.     set this [CMCmnType::constructor $class $this]
  2882.     set this [OPClassType::constructor $class $this]
  2883.     # Start constructor user section
  2884.     # End constructor user section
  2885.     return $this
  2886. }
  2887.  
  2888. method CMClassType::destructor {this} {
  2889.     # Start destructor user section
  2890.     # End destructor user section
  2891.     $this CMCmnType::destructor
  2892. }
  2893.  
  2894. selfPromoter OPClassType {this} {
  2895.     CMClassType promote $this
  2896. }
  2897.  
  2898. # Do not delete this line -- regeneration end marker
  2899.  
  2900. #---------------------------------------------------------------------------
  2901. #      File:           @(#)cmassocatt.tcl    /main/titanic/1
  2902. #---------------------------------------------------------------------------
  2903.  
  2904. # Start user added include file section
  2905. # End user added include file section
  2906.  
  2907.  
  2908. Class CMAssocAttr : {CMCmnAssocAttr OPAssocAttr} {
  2909.     constructor
  2910.     method destructor
  2911.     method prepare
  2912.     method oneGetPrepare
  2913.     method oneSetPrepare
  2914.     method oneRemovePrepare
  2915.     method manyGetPrepare
  2916.     method manySetPrepare
  2917.     method manyRemovePrepare
  2918. }
  2919.  
  2920. constructor CMAssocAttr {class this} {
  2921.     set this [CMCmnAssocAttr::constructor $class $this]
  2922.     set this [OPAssocAttr::constructor $class $this]
  2923.     # Start constructor user section
  2924.     # End constructor user section
  2925.     return $this
  2926. }
  2927.  
  2928. method CMAssocAttr::destructor {this} {
  2929.     # Start destructor user section
  2930.     # End destructor user section
  2931.     $this CMCmnAssocAttr::destructor
  2932. }
  2933.  
  2934. selfPromoter OPAssocAttr {this} {
  2935.     CMAssocAttr promote $this
  2936. }
  2937.  
  2938. method CMAssocAttr::prepare {this class model forwhat} {
  2939. my_debug "CMAssocAttr::prepare()"
  2940.     $this prepareForAssoc $class $model $forwhat
  2941. }
  2942.  
  2943. method CMAssocAttr::oneGetPrepare {this class model forwhat} {
  2944.     set type [[$this ooplType] getName]
  2945.     set name [cap [$this getName]]
  2946.  
  2947.     set op [$class addOperation get$name $type]
  2948.     $this copyAccessMode $op r
  2949. }
  2950.  
  2951. method CMAssocAttr::oneSetPrepare {this class model forwhat} {
  2952.     set type [[$this ooplType] getName]
  2953.     set name [cap [$this getName]]
  2954.  
  2955.     set op [$class addOperation set$name ""]
  2956.     $op addParameter new$name $type
  2957.  
  2958.     $this copyAccessMode $op w
  2959. }
  2960.  
  2961. method CMAssocAttr::oneRemovePrepare {this class model forwhat} {
  2962.     set name [cap [$this getName]]
  2963.  
  2964.     set op [$class addOperation remove$name ""]
  2965.     $this copyAccessMode $op w
  2966. }
  2967.  
  2968. method CMAssocAttr::manyGetPrepare {this class model forwhat} {
  2969.     set ordered [$this isOrdered]
  2970.     set settype [set_type_name [$this ooplType] $ordered]
  2971.     set setname [cap [set_name [$this getName] $ordered]]
  2972.  
  2973.     catch {$model addClass $settype}
  2974.     set op [$class addOperation get$setname $settype]
  2975.     $this copyAccessMode $op r
  2976. }
  2977.  
  2978. method CMAssocAttr::manySetPrepare {this class model forwhat} {
  2979.     set type [[$this ooplType] getName]
  2980.     set name [cap [$this getName]]
  2981.  
  2982.     set op [$class addOperation add$name ""]
  2983.     $op addParameter new$name $type
  2984.  
  2985.     $this copyAccessMode $op w
  2986. }
  2987.  
  2988. method CMAssocAttr::manyRemovePrepare {this class model forwhat} {
  2989.     if [$this isMandatory] {
  2990.     return
  2991.     }
  2992.  
  2993.     set type [[$this ooplType] getName]
  2994.     set name [cap [$this getName]]
  2995.  
  2996.     set op [$class addOperation remove$name ""]
  2997.     $op addParameter old$name $type
  2998.  
  2999.     $this copyAccessMode $op w
  3000. }
  3001.  
  3002. # Do not delete this line -- regeneration end marker
  3003.  
  3004. #---------------------------------------------------------------------------
  3005. #      File:           @(#)cmcadccdsu.tcl    /main/titanic/2
  3006. #---------------------------------------------------------------------------
  3007.  
  3008. # Start user added include file section
  3009. # End user added include file section
  3010.  
  3011.  
  3012. Class CMCADCCDSubject : {CMDiagSubject OPCADCCDSubject} {
  3013.     constructor
  3014.     method destructor
  3015.     method mcheck
  3016. }
  3017.  
  3018. constructor CMCADCCDSubject {class this} {
  3019.     set this [CMDiagSubject::constructor $class $this]
  3020.     set this [OPCADCCDSubject::constructor $class $this]
  3021.     # Start constructor user section
  3022.     # End constructor user section
  3023.     return $this
  3024. }
  3025.  
  3026. method CMCADCCDSubject::destructor {this} {
  3027.     # Start destructor user section
  3028.     # End destructor user section
  3029.     $this CMDiagSubject::destructor
  3030. }
  3031.  
  3032. selfPromoter OPCADCCDSubject {this} {
  3033.     CMCADCCDSubject promote $this
  3034. }
  3035.  
  3036. method CMCADCCDSubject::mcheck {this} {
  3037. my_debug "CMCADCCDSubject::mcheck()"
  3038.     $this cadCheck
  3039.     $this ccdCheck
  3040. }
  3041.  
  3042. # Do not delete this line -- regeneration end marker
  3043.  
  3044. #---------------------------------------------------------------------------
  3045. #      File:           @(#)cmsystemsu.tcl    /main/titanic/2
  3046. #---------------------------------------------------------------------------
  3047.  
  3048. # Start user added include file section
  3049. # End user added include file section
  3050.  
  3051.  
  3052. Class CMSystemSubject : {CMCmnSubject OPSystemSubject} {
  3053.     constructor
  3054.     method destructor
  3055.     method mcheck
  3056. }
  3057.  
  3058. constructor CMSystemSubject {class this} {
  3059.     set this [CMCmnSubject::constructor $class $this]
  3060.     set this [OPSystemSubject::constructor $class $this]
  3061.     # Start constructor user section
  3062.     # End constructor user section
  3063.     return $this
  3064. }
  3065.  
  3066. method CMSystemSubject::destructor {this} {
  3067.     # Start destructor user section
  3068.     # End destructor user section
  3069.     $this CMCmnSubject::destructor
  3070. }
  3071.  
  3072. selfPromoter OPSystemSubject {this} {
  3073.     CMSystemSubject promote $this
  3074. }
  3075.  
  3076. method CMSystemSubject::mcheck {this} {
  3077. my_debug "CMSystemSubject::mcheck()"
  3078.     #
  3079.     #  Check if each received event of this subject is handled by one of
  3080.     #  the classes in this system.
  3081.     #
  3082.     if {[M4CheckManager::errorControl $E_NO_MATCHING_OPER_IN_SUBJECT] == "off"} {
  3083.         return
  3084.     }
  3085.  
  3086.     set currSystemVersion [[ClientContext::global] currentSystem]
  3087.     if {[$currSystemVersion isNil]} {
  3088.     set systemName ""
  3089.     } else {
  3090.     set systemName [[$currSystemVersion system] name]
  3091.     }
  3092.  
  3093.     set subjectName [$this getName]
  3094.     set subjectType [$this get_obj_type]
  3095.     set diagramName "[$this getDiagramName].[$this getDiagramType]"
  3096.  
  3097.     #
  3098.     #  Go to the system specified by this subject, load and prepare the model
  3099.     #  for all classes in the system and check for every event received by
  3100.     #  this subject whether it is handled by some class.
  3101.     #
  3102.     if {[catch {fstorage::goto_system $subjectName} msg]} {
  3103.     m4_error $E_BAD_SYSTEM_SUBJECT $subjectName $diagramName $msg
  3104.     return
  3105.     }
  3106.     if {[catch {set classes [get_system_classes]} msg]} {
  3107.         puts stdout $msg
  3108.     catch {fstorage::goto_system $systemName}
  3109.         return
  3110.     }
  3111.     if {[lempty $classes]} {
  3112.         m4_error $E_SUBJECT_IS_EMPTY System $subjectName $diagramName
  3113.     catch {fstorage::goto_system $systemName}
  3114.         return
  3115.     }
  3116.  
  3117.     set modelChecker [ModelChecker new $classes ccd]
  3118.     $modelChecker loadModel 0 1 0
  3119.     if {[$modelChecker ooModel] == ""} {
  3120.         m4_message $M_LOADING_SUBJMODEL_FAILED $subjectType $subjectName
  3121.     catch {fstorage::goto_system $systemName}
  3122.         return
  3123.     }
  3124.     [$modelChecker ooplModel] prepare [$modelChecker ooplClasses] [$modelChecker ooplSubjects] check
  3125.  
  3126.     foreach recvEv [$this getReceivedEvents] {
  3127.     set found 0
  3128.     foreach class [$modelChecker ooplClasses] {
  3129.             if {[$recvEv checkMethodForEvent $class "" 1]} {
  3130.                 set found 1
  3131.                 break
  3132.             }
  3133.     }
  3134.         if {!$found} {
  3135.             m4_error $E_NO_MATCHING_OPER_IN_SUBJECT system $subjectName [$recvEv asStr]
  3136.         }
  3137.     }
  3138.  
  3139.     [$modelChecker ooModel] delete
  3140.  
  3141.     #
  3142.     #  Go to the original system
  3143.     #
  3144.     if {[catch {fstorage::goto_system $systemName} msg]} {
  3145.     puts stdout $msg
  3146.     return
  3147.     }
  3148. }
  3149.  
  3150. # Do not delete this line -- regeneration end marker
  3151.  
  3152. #---------------------------------------------------------------------------
  3153. #      File:           @(#)cmdblinkat.tcl    /main/titanic/1
  3154. #---------------------------------------------------------------------------
  3155.  
  3156. # Start user added include file section
  3157. # End user added include file section
  3158.  
  3159.  
  3160. Class CMDBLinkAttr : {CMCmnAssocAttr OPDBLinkAttr} {
  3161.     constructor
  3162.     method destructor
  3163.     method prepare
  3164.     method oneGetPrepare
  3165.     method manyGetPrepare
  3166. }
  3167.  
  3168. constructor CMDBLinkAttr {class this} {
  3169.     set this [CMCmnAssocAttr::constructor $class $this]
  3170.     set this [OPDBLinkAttr::constructor $class $this]
  3171.     # Start constructor user section
  3172.     # End constructor user section
  3173.     return $this
  3174. }
  3175.  
  3176. method CMDBLinkAttr::destructor {this} {
  3177.     # Start destructor user section
  3178.     # End destructor user section
  3179.     $this CMCmnAssocAttr::destructor
  3180. }
  3181.  
  3182. selfPromoter OPDBLinkAttr {this} {
  3183.     CMDBLinkAttr promote $this
  3184. }
  3185.  
  3186. method CMDBLinkAttr::prepare {this class model forwhat} {
  3187.     $this prepareForLink $class $model $forwhat
  3188. }
  3189.  
  3190. method CMDBLinkAttr::oneGetPrepare {this class model forwhat} {
  3191.     set type [[$this ooplType] getName]
  3192.     set name [cap "${type}Of[cap [$this getName]]"]
  3193.  
  3194.     set op [$class addOperation get$name $type]
  3195.     $this copyAccessMode $op r
  3196. }
  3197.  
  3198. method CMDBLinkAttr::manyGetPrepare {this class model forwhat} {
  3199.     set type [[$this ooplType] getName]
  3200.     set name [$this getName]
  3201.     set settype [set_type_name [$this ooplType]]
  3202.     set setname [cap [set_name $name]]
  3203.     set func_name get[cap [set_name "${type}Of[cap $name]"]]
  3204.  
  3205.     catch {$model addClass $settype}
  3206.     set op [$class addOperation $func_name int]
  3207.     $op addParameter $setname $settype
  3208.     $this copyAccessMode $op r
  3209. }
  3210.  
  3211. # Do not delete this line -- regeneration end marker
  3212.  
  3213. #---------------------------------------------------------------------------
  3214. #      File:           @(#)cmenumtype.tcl    /main/titanic/1
  3215. #---------------------------------------------------------------------------
  3216.  
  3217. # Start user added include file section
  3218. # End user added include file section
  3219.  
  3220.  
  3221. Class CMEnumType : {CMCmnType OPEnumType} {
  3222.     constructor
  3223.     method destructor
  3224. }
  3225.  
  3226. constructor CMEnumType {class this} {
  3227.     set this [CMCmnType::constructor $class $this]
  3228.     set this [OPEnumType::constructor $class $this]
  3229.     # Start constructor user section
  3230.     # End constructor user section
  3231.     return $this
  3232. }
  3233.  
  3234. method CMEnumType::destructor {this} {
  3235.     # Start destructor user section
  3236.     # End destructor user section
  3237.     $this CMCmnType::destructor
  3238. }
  3239.  
  3240. selfPromoter OPEnumType {this} {
  3241.     CMEnumType promote $this
  3242. }
  3243.  
  3244. # Do not delete this line -- regeneration end marker
  3245.  
  3246. #---------------------------------------------------------------------------
  3247. #      File:           @(#)cmreversel.tcl    /main/titanic/1
  3248. #---------------------------------------------------------------------------
  3249.  
  3250. # Start user added include file section
  3251. # End user added include file section
  3252.  
  3253.  
  3254. Class CMReverseLinkAttr : {CMCmnAssocAttr OPReverseLinkAttr} {
  3255.     constructor
  3256.     method destructor
  3257.     method prepare
  3258.     method oneGetPrepare
  3259.     method manyGetPrepare
  3260. }
  3261.  
  3262. constructor CMReverseLinkAttr {class this} {
  3263.     set this [CMCmnAssocAttr::constructor $class $this]
  3264.     set this [OPReverseLinkAttr::constructor $class $this]
  3265.     # Start constructor user section
  3266.     # End constructor user section
  3267.     return $this
  3268. }
  3269.  
  3270. method CMReverseLinkAttr::destructor {this} {
  3271.     # Start destructor user section
  3272.     # End destructor user section
  3273.     $this CMCmnAssocAttr::destructor
  3274. }
  3275.  
  3276. selfPromoter OPReverseLinkAttr {this} {
  3277.     CMReverseLinkAttr promote $this
  3278. }
  3279.  
  3280. method CMReverseLinkAttr::prepare {this class model forwhat} {
  3281. my_debug "CMReverseLinkAttr::prepare()"
  3282.     $this prepareForLink $class $model $forwhat
  3283. }
  3284.  
  3285. method CMReverseLinkAttr::oneGetPrepare {this class model forwhat} {
  3286.     set type [[$this ooplType] getName]
  3287.     set name [cap [$this getName]]
  3288.  
  3289.     set op [$class addOperation get$name $type]
  3290.     $this copyAccessMode $op r
  3291. }
  3292.  
  3293. method CMReverseLinkAttr::manyGetPrepare {this class model forwhat} {
  3294.     # does not occur
  3295. }
  3296.  
  3297. # Do not delete this line -- regeneration end marker
  3298.  
  3299. #---------------------------------------------------------------------------
  3300. #      File:           @(#)cmeventmes.tcl    /main/titanic/2
  3301. #---------------------------------------------------------------------------
  3302.  
  3303. # Start user added include file section
  3304. # End user added include file section
  3305.  
  3306.  
  3307.  
  3308. Class CMEventMessage : {CMReceivedEvent} {
  3309.     constructor
  3310.     method destructor
  3311.     method init
  3312.     method mcheck
  3313. }
  3314.  
  3315. constructor CMEventMessage {class this} {
  3316.     set this [CMReceivedEvent::constructor $class $this]
  3317.     # Start constructor user section
  3318.     $this init
  3319.     # End constructor user section
  3320.     return $this
  3321. }
  3322.  
  3323. method CMEventMessage::destructor {this} {
  3324.     # Start destructor user section
  3325.     # End destructor user section
  3326.     $this CMReceivedEvent::destructor
  3327. }
  3328.  
  3329. method CMEventMessage::init {this} {
  3330.     $this longType "STD Event Message"
  3331.     $this CMReceivedEvent::init
  3332. }
  3333.  
  3334. method CMEventMessage::mcheck {this class} {
  3335. my_debug "CMEventMessage::mcheck()"
  3336.     $this checkEventAttributes $class
  3337.     $this checkMethodForEvent $class
  3338. }
  3339.  
  3340. # Do not delete this line -- regeneration end marker
  3341.  
  3342. #---------------------------------------------------------------------------
  3343. #      File:           @(#)cmctorpara.tcl    /main/titanic/1
  3344. #---------------------------------------------------------------------------
  3345.  
  3346. # Start user added include file section
  3347. # End user added include file section
  3348.  
  3349.  
  3350. Class CMCtorParameter : {OPCtorParameter CMParameter} {
  3351.     constructor
  3352.     method destructor
  3353.     method prepare
  3354. }
  3355.  
  3356. constructor CMCtorParameter {class this} {
  3357.     set this [OPCtorParameter::constructor $class $this]
  3358.     set this [CMParameter::constructor $class $this]
  3359.     # Start constructor user section
  3360.     # End constructor user section
  3361.     return $this
  3362. }
  3363.  
  3364. method CMCtorParameter::destructor {this} {
  3365.     # Start destructor user section
  3366.     # End destructor user section
  3367.     $this CMParameter::destructor
  3368. }
  3369.  
  3370. selfPromoter OPCtorParameter {this} {
  3371.     CMCtorParameter promote $this
  3372. }
  3373.  
  3374. method CMCtorParameter::prepare {this class model forwhat} {
  3375. my_debug "CMCtorParameter::prepare()"
  3376.     # empty
  3377. }
  3378.  
  3379. # Do not delete this line -- regeneration end marker
  3380.  
  3381. #---------------------------------------------------------------------------
  3382. #      File:           @(#)cmdbdataat.tcl    /main/titanic/1
  3383. #---------------------------------------------------------------------------
  3384.  
  3385. # Start user added include file section
  3386. # End user added include file section
  3387.  
  3388.  
  3389. Class CMDBDataAttr : {CMbDataAttr OPDBDataAttr} {
  3390.     constructor
  3391.     method destructor
  3392.     method prepare
  3393. }
  3394.  
  3395. constructor CMDBDataAttr {class this} {
  3396.     set this [CMbDataAttr::constructor $class $this]
  3397.     set this [OPDBDataAttr::constructor $class $this]
  3398.     # Start constructor user section
  3399.     # End constructor user section
  3400.     return $this
  3401. }
  3402.  
  3403. method CMDBDataAttr::destructor {this} {
  3404.     # Start destructor user section
  3405.     # End destructor user section
  3406.     $this CMbDataAttr::destructor
  3407. }
  3408.  
  3409. selfPromoter OPDBDataAttr {this} {
  3410.     CMDBDataAttr promote $this
  3411. }
  3412.  
  3413. method CMDBDataAttr::prepare {this class model forwhat} {
  3414.     set name [cap [$this getName]]
  3415.     set type [[$this ooplType] getName]
  3416.     set column [$this column]
  3417.  
  3418.     set op [$class addOperation get$name $type]
  3419.     $this copyAccessMode $op r
  3420.  
  3421.     if {[$column getColumnType] == "field"} {
  3422.     set op [$class addOperation set$name ""]
  3423.     $op addParameter new$name $type
  3424.         $this copyAccessMode $op w
  3425.     }
  3426.  
  3427.     if [$column isNullable] {
  3428.     set op [$class addOperation "[uncap $name]IsNull" int]
  3429.     $this copyAccessMode $op r
  3430.  
  3431.     set op [$class addOperation nullify$name ""]
  3432.     $this copyAccessMode $op w
  3433.     }
  3434. }
  3435.  
  3436. # Do not delete this line -- regeneration end marker
  3437.  
  3438. #---------------------------------------------------------------------------
  3439. #      File:           @(#)cmcadsubje.tcl    /main/titanic/2
  3440. #---------------------------------------------------------------------------
  3441.  
  3442. # Start user added include file section
  3443. # End user added include file section
  3444.  
  3445.  
  3446. Class CMCADSubject : {CMDiagSubject OPCADSubject} {
  3447.     constructor
  3448.     method destructor
  3449.     method mcheck
  3450. }
  3451.  
  3452. constructor CMCADSubject {class this} {
  3453.     set this [CMDiagSubject::constructor $class $this]
  3454.     set this [OPCADSubject::constructor $class $this]
  3455.     # Start constructor user section
  3456.     # End constructor user section
  3457.     return $this
  3458. }
  3459.  
  3460. method CMCADSubject::destructor {this} {
  3461.     # Start destructor user section
  3462.     # End destructor user section
  3463.     $this CMDiagSubject::destructor
  3464. }
  3465.  
  3466. selfPromoter OPCADSubject {this} {
  3467.     CMCADSubject promote $this
  3468. }
  3469.  
  3470. method CMCADSubject::mcheck {this} {
  3471. my_debug "CMCADSubject::mcheck()"
  3472.     $this cadCheck
  3473. }
  3474.  
  3475. # Do not delete this line -- regeneration end marker
  3476.  
  3477. #---------------------------------------------------------------------------
  3478. #      File:           @(#)cmdblinkcl.tcl    /main/titanic/2
  3479. #---------------------------------------------------------------------------
  3480.  
  3481. # Start user added include file section
  3482. # End user added include file section
  3483.  
  3484.  
  3485. Class CMDBLinkClass : {CMCmnClass OPDBLinkClass} {
  3486.     constructor
  3487.     method destructor
  3488.     method prepare
  3489. }
  3490.  
  3491. constructor CMDBLinkClass {class this} {
  3492.     set this [CMCmnClass::constructor $class $this]
  3493.     set this [OPDBLinkClass::constructor $class $this]
  3494.     # Start constructor user section
  3495.     # End constructor user section
  3496.     return $this
  3497. }
  3498.  
  3499. method CMDBLinkClass::destructor {this} {
  3500.     # Start destructor user section
  3501.     # End destructor user section
  3502.     $this CMCmnClass::destructor
  3503. }
  3504.  
  3505. selfPromoter OPDBLinkClass {this} {
  3506.     CMDBLinkClass promote $this
  3507. }
  3508.  
  3509. method CMDBLinkClass::prepare {this model forwhat} {
  3510. my_debug "CMDBLinkClass::prepare()"
  3511.     # $this CMLinkClass::prepare ...
  3512.     $this CMCmnClass::prepare $model $forwhat
  3513.     if {$forwhat == "check"} {
  3514.     prepare_db_class $this $model
  3515.     }
  3516. }
  3517.  
  3518. # Do not delete this line -- regeneration end marker
  3519.  
  3520. #---------------------------------------------------------------------------
  3521. #      File:           @(#)cmcommmess.tcl    /main/titanic/2
  3522. #---------------------------------------------------------------------------
  3523.  
  3524. # Start user added include file section
  3525. # End user added include file section
  3526.  
  3527.  
  3528.  
  3529. Class CMCommMessage : {CMReceivedEvent} {
  3530.     constructor
  3531.     method destructor
  3532.     method init
  3533.     method mcheck
  3534. }
  3535.  
  3536. constructor CMCommMessage {class this} {
  3537.     set this [CMReceivedEvent::constructor $class $this]
  3538.     # Start constructor user section
  3539.     $this init
  3540.     # End constructor user section
  3541.     return $this
  3542. }
  3543.  
  3544. method CMCommMessage::destructor {this} {
  3545.     # Start destructor user section
  3546.     # End destructor user section
  3547.     $this CMReceivedEvent::destructor
  3548. }
  3549.  
  3550. method CMCommMessage::init {this} {
  3551.     $this longType "CCD Communication Message"
  3552.     $this CMReceivedEvent::init
  3553. }
  3554.  
  3555. method CMCommMessage::mcheck {this class} {
  3556. my_debug "CMCommMessage::mcheck()"
  3557.     $this checkMethodForEvent $class
  3558. }
  3559.  
  3560. # Do not delete this line -- regeneration end marker
  3561.  
  3562.