home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / reqdriver.tcl < prev    next >
Text File  |  1997-08-29  |  9KB  |  284 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)reqdriver.tcl    /main/titanic/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)reqdriver.tcl    /main/titanic/2   29 Aug 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class ReqDriver : {GCObject} {
  16.     constructor
  17.     method destructor
  18.     method init
  19.     method applyToLevel
  20.     method applyRecursive
  21.     method elementSet
  22.     method addElement
  23.     method removeElement
  24.     attribute corporate
  25.     attribute project
  26.     attribute configV
  27.     attribute phaseV
  28.     attribute systemV
  29.     attribute fileV
  30.     attribute integrationType
  31.     attribute prefix
  32.     attribute _elementSet
  33. }
  34.  
  35. constructor ReqDriver {class this} {
  36.     set this [GCObject::constructor $class $this]
  37.     $this _elementSet [List new]
  38.     # Start constructor user section
  39.  
  40.     source [m4_path_name tcl platform.tcl]
  41.        set cc [ClientContext::global]
  42.         $this corporate [$cc currentCorporate]
  43.         $this project [$cc currentProject]
  44.         $this configV [$cc currentConfig]
  45.         $this phaseV [$cc currentPhase]
  46.         $this systemV [$cc currentSystem]
  47.         $this fileV [$cc currentFile]
  48.     # End constructor user section
  49.     return $this
  50. }
  51.  
  52. method ReqDriver::destructor {this} {
  53.     # Start destructor user section
  54.     # End destructor user section
  55. }
  56.  
  57. method ReqDriver::init {this intType prefix} {
  58.     $this integrationType $intType
  59.     $this prefix $prefix
  60.     
  61.     set intType [$this integrationType]
  62.  
  63.     [$this prefix]Driver::getProjectName
  64.  
  65.     set doorsSections [m4_var get M4_${intType}_section_mapping]
  66.     if ![llength $doorsSections] {
  67.             m4_var set M4_${intType}_section_mapping {\
  68.                 etd "Sequence Diagram" \
  69.                 ucd "Use Case Diagram" \
  70.                 std "State Diagrams" \
  71.                 cad "Class Diagram"\
  72.                 dfd "Data Flow Diagram"\
  73.                 ccd "Class Communication Diagram"\
  74.                 cod "Class Object Diagram"\
  75.                 mgd "Message Generalization Diagram"\
  76.                 c++ "C++-Source File"\
  77.                 h++ "C++-Header File"\
  78.                 UseCase "Use Case"\
  79.                 lex++ "Lex File Section"\
  80.             }
  81.         m4_var saveStatus M4_${intType}_section_mapping 0
  82.     }
  83.  
  84.  
  85.     set intProp [m4_var get M4_${intType}_integrated_properties]
  86.     if ![llength $intProp] {
  87.             m4_var set M4_${intType}_integrated_properties freeText
  88.         m4_var saveStatus M4_${intType}_integrated_properties 0
  89.     } 
  90.  
  91.     set objText [m4_var get M4_${intType}_objecttext_property]
  92.     if ![llength $objText] {
  93.             m4_var set M4_${intType}_objecttext_property freeText
  94.             m4_var saveStatus M4_${intType}_objecttext_property 0
  95.     } 
  96. }
  97.  
  98. proc ReqDriver::getVersion {levelV} {
  99.     set versionNumber [$levelV versionNumber]
  100.     set origConf [$levelV [$levelV ORB_class]::config]
  101.     set origConfName [$origConf name]
  102.     return "$origConfName.$versionNumber"
  103. }
  104.  
  105. proc ReqDriver::getSMTypeName {semType} {
  106.     set semTypeName [$semType name]
  107.         set filteredName  $semTypeName
  108.         if {[llength $semTypeName] > 1} {
  109.         set filteredName [lindex $semTypeName 1]
  110.         }
  111.         if {[llength $semTypeName] > 2} {
  112.         set filteredName [lindex $semTypeName 2]
  113.         }
  114.         return $filteredName
  115. }
  116.  
  117. method ReqDriver::applyToLevel {this objTeamObjs operation dxlCommandRef {arg1 ""} {arg2 ""}} {
  118.         upvar $dxlCommandRef dxlCommand
  119.         set orgOperation $operation
  120.         set operation install
  121.     
  122.         set corporate [$this corporate]
  123.         set project [$this project]
  124.         set configV [$this configV]
  125.         set phaseV [$this phaseV]
  126.         set systemV [$this systemV]
  127.         set fileV [$this fileV]
  128.  
  129.         $this applyToMultiple $project $corporate $operation dxlCommand $arg1 $arg2 
  130.  
  131.         set currentLevel $phaseV
  132.         set parentLevel $configV
  133.         $this applyToMultiple $phaseV $configV $operation dxlCommand $arg1 $arg2 
  134.  
  135.         if ![$systemV isNil] {
  136.         set currentLevel $systemV
  137.         set parentLevel $phaseV
  138.         $this applyToMultiple $systemV $phaseV $operation dxlCommand $arg1 $arg2 
  139.         }
  140.  
  141.         if ![$fileV isNil] {
  142.         set currentLevel $fileV
  143.         set parentLevel $systemV
  144.         $this applyToMultiple $fileV $systemV $operation dxlCommand $arg1 $arg2 
  145.         }
  146.  
  147.         if [$fileV isNil]  {
  148.         $this applyToMultiple $objTeamObjs $currentLevel $operation dxlCommand $arg1 $arg2 
  149.         $this applyToMultiple $currentLevel $parentLevel $orgOperation dxlCommand $arg1 $arg2 
  150.     }
  151. }
  152.  
  153. method ReqDriver::applyRecursive {this objTeamObjs parentOTObject operation dxlCommandRef {arg1 ""} {arg2 ""} {objectsDone ""}} {
  154.         upvar $dxlCommandRef dxlCommand
  155.         if ![llength $objTeamObjs] {
  156.         return
  157.         }
  158.         if {[llength $objTeamObjs] > 1} {
  159.         foreach objTeamObj $objTeamObjs {
  160.              $this applyRecursive $objTeamObj $parentOTObject $operation dxlCommand $arg1 $arg2 $objectsDone
  161.         }
  162.         return
  163.         }
  164.         set objTeamObj $objTeamObjs
  165.         if {[lsearch "install filter installRefs" $operation] != -1 && [lsearch $objectsDone $objTeamObj] == -1} {
  166.         $this applyToMultiple $objTeamObj $parentOTObject $operation dxlCommand $arg1 $arg2
  167.         lappend objectsDone $objTeamObj
  168.         }
  169.  
  170.         set toDo ""
  171.         if [$objTeamObj isA Project]  {
  172.         set toDo [$objTeamObj configVersions]
  173.         }
  174.  
  175.         if [$objTeamObj isA Config]  {
  176.         set toDo  [$objTeamObj phaseVersions]
  177.         }
  178.  
  179.         if [$objTeamObj isA PhaseVersion]  {
  180.         set toDo  [$objTeamObj systemVersions]
  181.         }
  182.  
  183.         if [$objTeamObj isA SystemVersion]  {
  184.         set toDo [$objTeamObj localFileVersions]
  185.         }
  186.         set objectsDone [$this applyRecursive $toDo  $objTeamObj $operation dxlCommand $arg1 $arg2 $objectsDone]
  187.  
  188.         return $objectsDone
  189. }
  190.  
  191. proc ReqDriver::searchOnName {objList name} {
  192.     # searchlist consists of customlevels and workItems.semType
  193.     set type [lindex [split $name .] 1]
  194.     set name [lindex [split $name .] 0]
  195.     foreach element $objList {
  196.         if ![isCommand $element] {
  197.         set splitIndex [string last . $element]
  198.         set typeIndex [expr $splitIndex + 1]
  199.         set endNameIndex [expr $splitIndex - 1]
  200.         set elementType [string range $element $typeIndex end]
  201.         set element [string range $element 0 $endNameIndex]
  202.         } else {
  203.         set elementType [$element type]
  204.         }
  205.         if [$element isA File] {
  206.            set elementName [$element qualifiedName :]
  207.         } else {
  208.            set elementName [$element name]
  209.         }
  210.         if {$elementName == $name} {
  211.         if { ![llength $type] || $type == $elementType} {
  212.             return $element
  213.         }
  214.         }
  215.     }
  216. }
  217.  
  218. proc ReqDriver::searchOnVersion {objList versionId} {
  219.     foreach levelV $objList {
  220.         set versionNumber [$levelV versionNumber]
  221.         set origConf [$levelV [$levelV ORB_class]::config]
  222.         set origConfName [$origConf name]
  223.         if {"$origConfName.$versionNumber" == $versionId} {
  224.             return $levelV
  225.         }
  226.     }
  227. }
  228.  
  229. proc ReqDriver::searchOnNameAndVersion {objList name versionId} {
  230.     # searchlist consists of customlevels and workItems.semType
  231.     set type [lindex [split $name .] 1]
  232.     set name [lindex [split $name .] 0]
  233.     foreach element $objList {
  234.         if ![isCommand $element] {
  235.         set splitIndex [string last . $element]
  236.         set typeIndex [expr $splitIndex + 1]
  237.         set endNameIndex [expr $splitIndex - 1]
  238.         set elementType [string range $element $typeIndex end]
  239.         set element [string range $element 0 $endNameIndex]
  240.         } else {
  241.         set levelV $element
  242.         set elementType [[$levelV object] type]
  243.         }
  244.         if [$element isA FileVersion] {
  245.            set file [$element file]
  246.            set elementName [$file qualifiedName :]
  247.         } else {
  248.            set elementName [$element name]
  249.         }
  250.         if {$elementName == $name} {
  251.         if { ![llength $type] || $type == $elementType} {
  252.             if ![llength $versionId] {
  253.             # element is not versiond
  254.             return $element
  255.             }
  256.             set levelV $element
  257.             set versionNumber [$levelV versionNumber]
  258.             set origConf [$levelV [$levelV ORB_class]::config]
  259.             set origConfName [$origConf name]
  260.             if {"$origConfName.$versionNumber" == $versionId} {
  261.             return $levelV
  262.             }
  263.         }
  264.         }
  265.     }
  266. }
  267.  
  268. # Do not delete this line -- regeneration end marker
  269.  
  270. method ReqDriver::elementSet {this} {
  271.     return [$this _elementSet]
  272. }
  273.  
  274. method ReqDriver::addElement {this newElement} {
  275.     [$this _elementSet] append $newElement
  276.     $newElement _driver $this
  277. }
  278.  
  279. method ReqDriver::removeElement {this oldElement} {
  280.     $oldElement _driver ""
  281.     [$this _elementSet] removeValue $oldElement
  282. }
  283.  
  284.