home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / drsprocs.tcl < prev    next >
Text File  |  1997-05-20  |  12KB  |  372 lines
  1. # Copyright (c) 1997 by Cayenne Software Inc.
  2. #
  3. # This software is furnished under a license and may be used only in
  4. # accordance with the terms of such license and with the inclusion of
  5. # the above copyright notice. This software or any other copies thereof
  6. # may not be provided or otherwise made available to any other person.
  7. # No title to and ownership of the software is hereby transferred.
  8. #
  9. # The information in this software is subject to change without notice
  10. # and should not be construed as a commitment by Cayenne Software Inc
  11. #
  12. #---------------------------------------------------------------------------
  13. #
  14. #       File            : @(#)drsprocs.tcl    /main/hindenburg/17 23 Jan 1997
  15. #       Author          : H. Broeze
  16. #       Original date   : 14 Januari 1997
  17. #       Description     : DOORS integration procedures
  18. #
  19. #---------------------------------------------------------------------------
  20. #
  21. require drsdefs.tcl
  22. source [m4_path_name tcl  drsdxlcomm.tcl]
  23. source [m4_path_name tcl  drsobject.tcl]
  24. source [m4_path_name tcl  drstreeobj.tcl]
  25. source [m4_path_name tcl  drslevelob.tcl]
  26. source [m4_path_name tcl  drscorpobj.tcl]
  27. source [m4_path_name tcl  drsprojobj.tcl]
  28. source [m4_path_name tcl  drssmmodel.tcl]
  29. source [m4_path_name tcl  drsphaseob.tcl]
  30. source [m4_path_name tcl  drslinkabl.tcl]
  31. source [m4_path_name tcl  drssystemo.tcl]
  32. source [m4_path_name tcl  drsgrouped.tcl]
  33. source [m4_path_name tcl  drsfileobj.tcl]
  34. source [m4_path_name tcl  drsqobject.tcl]
  35. source [m4_path_name tcl  drsqfileob.tcl]
  36. source [m4_path_name tcl  drsitemobj.tcl]
  37. source [m4_path_name tcl  drsqitemob.tcl]
  38. source [m4_path_name tcl  drssmitemo.tcl]
  39.  
  40. proc getVersion { levelV } {
  41.     set versionNumber [$levelV versionNumber]
  42.     set origConf [$levelV [$levelV ORB_class]::config]
  43.     set origConfName [$origConf name]
  44.     return "$origConfName.$versionNumber"
  45. }
  46.  
  47.  
  48. proc initSynchronize { } {
  49.     global DxlError
  50.     set DxlError 0
  51.     global frozenFiles
  52.     set frozenFiles ""
  53.     global notIntQualFiles
  54.     set notIntQualFiles ""
  55. }
  56.  
  57. proc endSynchronize { } {
  58.     global frozenFiles
  59.     global notIntQualFiles
  60.     [.main messageArea] message ""
  61.     set frozenMessage ""
  62.     set qualMessage ""
  63.     foreach drsF $frozenFiles {
  64.     set frozenMessage "$frozenMessage\n      [$drsF levelName]"
  65.     }
  66.     foreach drsQ $notIntQualFiles {
  67.     set qualMessage "$qualMessage\n      [$drsQ levelName]"
  68.     }
  69.     set message ""
  70.     if [llength $frozenMessage] {
  71.     set message "The following frozen diagrams/objects can not be installed in DOORS:\n $frozenMessage\n\nbecause no working version was synchronized before."
  72.     }
  73.     if [llength $qualMessage] {
  74.     if [llength $message] {
  75.         set message "${message}\n\n--------------------------------------------\n\n"
  76.     }
  77.     set message "${message}The following qualified diagrams can not be installed in DOORS:\n $qualMessage\n\nbecause their qualified objects (Class/Use Case) do not exist." 
  78.     }
  79.     if [llength $message] {
  80.     wmtkwarning $message
  81.     }
  82. }
  83.  
  84. proc getSMTypeName { semType } {
  85.     set semTypeName [$semType name]
  86.     set filteredName  $semTypeName
  87.     if {[llength $semTypeName] > 1} {
  88.     set filteredName [lindex $semTypeName 1]
  89.     }
  90.     if {[llength $semTypeName] > 2} {
  91.     set filteredName [lindex $semTypeName 2]
  92.     }
  93.     return $filteredName
  94. }
  95.  
  96. proc searchOnName { searchList name} {
  97.     # searchlist consists of customlevels and workItems.semType
  98.     set type [lindex [split $name .] 1]
  99.     set name [lindex [split $name .] 0]
  100.     foreach element $searchList {
  101.     if ![isCommand $element] {
  102.         set splitIndex [string last . $element]
  103.         set typeIndex [expr $splitIndex + 1]
  104.         set endNameIndex [expr $splitIndex - 1]
  105.         set elementType [string range $element $typeIndex end]
  106.         set element [string range $element 0 $endNameIndex]
  107.     } else {
  108.         set elementType [$element type]
  109.     }
  110.     if [$element isA File] {
  111.        set elementName [$element qualifiedName :]
  112.     } else {
  113.        set elementName [$element name]
  114.     }
  115.     if {$elementName == $name} { 
  116.         if { ![llength $type] || $type == $elementType} {
  117.         return $element
  118.         }
  119.     }
  120.     }
  121. }
  122.  
  123. proc searchOnNameAndVersion { searchList name versionId} {
  124.     # searchlist consists of customlevels and workItems.semType
  125.     set type [lindex [split $name .] 1]
  126.     set name [lindex [split $name .] 0]
  127.     foreach element $searchList {
  128.     if ![isCommand $element] {
  129.         set splitIndex [string last . $element]
  130.         set typeIndex [expr $splitIndex + 1]
  131.         set endNameIndex [expr $splitIndex - 1]
  132.         set elementType [string range $element $typeIndex end]
  133.         set element [string range $element 0 $endNameIndex]
  134.     } else {
  135.         set levelV $element 
  136.         set elementType [[$levelV object] type]
  137.     }
  138.     if [$element isA FileVersion] {
  139.        set file [$element file]
  140.            set elementName [$file qualifiedName :]
  141.         } else {
  142.            set elementName [$element name]
  143.         }
  144.     if {$elementName == $name} { 
  145.         if { ![llength $type] || $type == $elementType} {
  146.         if ![llength $versionId] {
  147.             # element is not versiond
  148.             return $element
  149.         }
  150.         set levelV $element
  151.         set versionNumber [$levelV versionNumber]
  152.         set origConf [$levelV [$levelV ORB_class]::config]
  153.         set origConfName [$origConf name]
  154.         if {"$origConfName.$versionNumber" == $versionId} { 
  155.             return $levelV
  156.         }
  157.         }
  158.     }
  159.     }
  160. }
  161.  
  162.  
  163. proc searchOnVersion { searchList versionId} {
  164.     foreach levelV $searchList {
  165.     set versionNumber [$levelV versionNumber]
  166.     set origConf [$levelV [$levelV ORB_class]::config]
  167.     set origConfName [$origConf name]
  168.     if {"$origConfName.$versionNumber" == $versionId} { 
  169.         return $levelV
  170.     }
  171.     }
  172. }
  173.         
  174. proc applyToLevel { objTeamObjs operation dxlCommandRef {arg1 ""} {arg2 ""}} {
  175.     upvar $dxlCommandRef dxlCommand
  176.     set orgOperation $operation
  177.     global DxlError
  178.     set DxlError 0
  179.     if {$orgOperation == "synObjects"} {
  180.     set operation install
  181.     }
  182.     set cc [ClientContext::global]
  183.     set corporate [$cc currentCorporate]
  184.     set project [$cc currentProject]
  185.     set configV [$cc currentConfig]
  186.     set phaseV [$cc currentPhase]
  187.     set systemV [$cc currentSystem]
  188.     set fileV [$cc currentFile]
  189.  
  190.     #applyToMultiple $corporate "" $operation dxlCommand $arg1 $arg2 
  191.     applyToMultiple $project $corporate $operation dxlCommand $arg1 $arg2 
  192.  
  193.     set currentLevel $phaseV
  194.     set parentLevel $configV
  195.     applyToMultiple $phaseV $configV $operation dxlCommand $arg1 $arg2 
  196.  
  197.     if ![$systemV isNil] {
  198.     set currentLevel $systemV
  199.     set parentLevel $phaseV
  200.     applyToMultiple $systemV $phaseV $operation dxlCommand $arg1 $arg2 
  201.     }
  202.  
  203.     if ![$fileV isNil] {
  204.     set currentLevel $fileV
  205.     set parentLevel $systemV
  206.     applyToMultiple $fileV $systemV $operation dxlCommand $arg1 $arg2 
  207.     }
  208.  
  209.     if {$orgOperation == "synObjects" } {
  210.     if [$fileV isNil]  {
  211.         applyToMultiple $objTeamObjs $currentLevel $operation dxlCommand $arg1 $arg2 
  212.         applyToMultiple $currentLevel $parentLevel $orgOperation dxlCommand $arg1 $arg2 
  213.     }
  214.     } 
  215.     if {$orgOperation != "filter"} {
  216.     return
  217.     }
  218.  
  219.     if { $arg2 == "Objects"} {
  220.     applyToMultiple $objTeamObjs $parentLevel showSMObjects dxlCommand $arg1 $arg2 
  221.     }
  222.     if {$arg2 == "ClassFeatures"} {
  223.     applyToMultiple $objTeamObjs $parentLevel showClassFeatures dxlCommand $arg1 $arg2 
  224.     }
  225.  
  226.     if {$objTeamObjs == $currentLevel } {
  227.     applyRecursive $objTeamObjs $parentLevel $operation dxlCommand $arg1 $arg2 ""
  228.     } else {
  229.     applyRecursive $objTeamObjs $currentLevel $operation dxlCommand $arg1 $arg2 ""
  230.     }
  231. }
  232.  
  233. proc getDoorsProjectName { } {
  234.     set doorsObj [DrsObject new ""]
  235.     set dxlCommand [DrsDxlCommand new]
  236.     $dxlCommand doorsInitialize "false"
  237.     $dxlCommand mustBeDone 1
  238.     $dxlCommand doorsResultSave projectName
  239.     return [$dxlCommand execute]
  240. }
  241.  
  242. proc applyToMultiple { objTeamObjs orgParentOTObj operation dxlCommandRef {arg1 ""} {arg2 ""}} {
  243.     set doorsProject [m4_var get M4_doors_project]
  244.     
  245.     global DxlError
  246.     if $DxlError {
  247.     if {[lsearch "filter showSMObjects showClassFeatures" $operation] == -1} {
  248.         return
  249.     }
  250.     }
  251.     if ![llength  $doorsProject] {
  252.     set doorsProject [getDoorsProjectName]
  253.     m4_var set M4_doors_project $doorsProject
  254.     }
  255.     if ![llength $doorsProject] {
  256.     wmtkerror "No Doors Project Opened"
  257.     return
  258.     }
  259.     global FORMALMODULE
  260.     set FORMALMODULE DOORS_${doorsProject}_[m4_var get M4_doors_formal_module]
  261.     
  262.     upvar $dxlCommandRef dxlCommand
  263.     if {$arg2 == "All"} {
  264.     set doorsObj [DrsObject new ""]
  265.     $doorsObj dxlCommand $dxlCommand
  266.     $doorsObj $operation $arg1 $arg2
  267.     set dxlCommand [$doorsObj dxlCommand]
  268.     return
  269.     }
  270.  
  271.     foreach objTeamObj $objTeamObjs  {
  272.         set parentOTObj $orgParentOTObj
  273.         if [$objTeamObj  isA ConfigVersion] {
  274.         set phases [$objTeamObj phaseVersions]
  275.         continue
  276.     } elseif [$objTeamObj  isA Corporate] {
  277.             set doorsObj [DrsCorpObject new $objTeamObj]
  278.         } elseif [$objTeamObj  isA Project] {
  279.             set doorsObj [DrsProjObject new $objTeamObj $parentOTObj]
  280.         } else {
  281.         set level [$objTeamObj object]
  282.         set origConf [$objTeamObj [$objTeamObj ORB_class]::config]
  283.         set origConfName [$origConf name]
  284.         set versionNumber [$objTeamObj versionNumber]
  285.         set levelVersion $origConfName.$versionNumber
  286.  
  287.         set parOrigConf [$parentOTObj [$parentOTObj ORB_class]::config]
  288.         set parOrigConfName [$parOrigConf name]
  289.         set pVersionNumber [$parentOTObj versionNumber]
  290.         set pVers $parOrigConfName.$pVersionNumber
  291.  
  292.         if [$objTeamObj  isA PhaseVersion] {
  293.         set parentOTObj [$parentOTObj project]
  294.         set pLevel [$parentOTObj  customLevel]
  295.         set doorsObj [DrsPhaseObject new $level \
  296.                         $levelVersion $pLevel $pVers ]
  297.         } else {
  298.         set pLevel [$parentOTObj  customLevel]
  299.         }
  300.         if [$objTeamObj  isA SystemVersion] {
  301.         set doorsObj [DrsSystemObject new $level \
  302.                         $levelVersion $pLevel $pVers]
  303.         } elseif [$objTeamObj  isA FileVersion] {
  304.         if {[[$objTeamObj file] type] == "cdm" } {
  305.             #skip cdm
  306.             continue
  307.         }
  308.         set doorsObj [DrsFileObject new $level \
  309.                         $levelVersion $pLevel $pVers]
  310.         }
  311.     }
  312.  
  313.  
  314.     $doorsObj dxlCommand $dxlCommand
  315.         if [llength $arg1]  {
  316.             if ![llength $arg2] {
  317.                 set dxlResult [$doorsObj $operation $arg1]
  318.             } else {
  319.                 set dxlResult [$doorsObj $operation $arg1 $arg2]
  320.             }
  321.         } else {
  322.             set dxlResult [$doorsObj $operation]
  323.         }
  324.     if ![llength $dxlResult] {
  325.         set DxlError 1
  326.     }
  327.     set dxlCommand [$doorsObj dxlCommand]
  328.     }
  329. }
  330.  
  331.  
  332. proc applyRecursive { objTeamObjs parentOTObject operation dxlCommandRef {arg1 ""} {arg2 ""} {objectsDone ""}} {
  333.     upvar $dxlCommandRef dxlCommand
  334.     if ![llength $objTeamObjs] {
  335.     return
  336.     }
  337.     if {[llength $objTeamObjs] > 1} {
  338.     foreach objTeamObj $objTeamObjs {
  339.          applyRecursive $objTeamObj $parentOTObject $operation dxlCommand $arg1 $arg2 $objectsDone
  340.     }
  341.     return
  342.     }
  343.     set objTeamObj $objTeamObjs
  344.     if {[lsearch "install filter installRefs" $operation] != -1 && [lsearch $objectsDone $objTeamObj] == -1} {
  345.     applyToMultiple $objTeamObj $parentOTObject $operation dxlCommand $arg1 $arg2
  346.     lappend objectsDone $objTeamObj
  347.     }
  348.  
  349.     set toDo ""
  350.     if [$objTeamObj isA Project]  {
  351.     set toDo [$objTeamObj configVersions]
  352.     }
  353.  
  354.     if [$objTeamObj isA Config]  {
  355.     set toDo  [$objTeamObj phaseVersions]
  356.     }
  357.  
  358.     if [$objTeamObj isA PhaseVersion]  {
  359.     set toDo  [$objTeamObj systemVersions]
  360.     }
  361.  
  362.     if [$objTeamObj isA SystemVersion]  {
  363.     set toDo [$objTeamObj localFileVersions]
  364.     }
  365.     set objectsDone [applyRecursive $toDo  $objTeamObj $operation dxlCommand $arg1 $arg2 $objectsDone]
  366.  
  367.     if {$operation == "deleteObject"} {
  368.     applyToMultiple $objTeamObj $parentOTObject $operation dxlCommand $arg1 $arg2
  369.     }
  370.     return $objectsDone
  371. }
  372.