home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / upgrade_menus.tcl < prev    next >
Encoding:
Text File  |  1996-08-27  |  8.4 KB  |  341 lines
  1. OTShRegister::repository
  2.  
  3. source [m4_path_name tcl libocl.tcl]
  4.  
  5. require procs.tcl
  6. require messagehdl.tcl
  7.  
  8. set CC [ClientContext::global]
  9.  
  10. global diffDict
  11. global adjustedFid
  12. global adjusted
  13. global menuList
  14.  
  15. set menuList {desk diagram cad ccd dfd etd mgd std ucd}
  16.  
  17. proc makeTclName {displayName} {
  18.  
  19.     regsub -all "\\\.| |\t" $displayName "" strippedString 
  20.  
  21.     return [string tolower $strippedString]
  22. }
  23.  
  24. proc registerObject {specification} {
  25.  
  26.     set spec  $specification
  27.     set objSpec ""
  28.     set name ""
  29.     set type ""
  30.  
  31.     while {![lempty $specification]} {
  32.         set key [lvarpop specification]
  33.         if {$key == "name"} {
  34.             set name [lvarpop specification]
  35.         } elseif {$key == "objSpec"} {
  36.             set objSpec [lvarpop specification]
  37.         } elseif {$key == "type"} {
  38.             set type [lvarpop specification]
  39.         }
  40.     }
  41.  
  42.     # determine right name
  43.     set index [lsearch -exact $objSpec "label"]
  44.     if {$index != -1} {
  45.         incr index
  46.         set displayName [lindex $objSpec $index]
  47.         set newName [makeTclName $displayName]
  48.     } else {
  49.     # no label found, take old name
  50.     set newName [getName $name]
  51.     }
  52.  
  53.     # determine right path
  54.     set pathList [path2List [getParent $name]]
  55.     set newPath ""
  56.     set orgPath ""
  57.     foreach pathElm $pathList {
  58.         set newPath $newPath.$pathElm
  59.         set orgPath $orgPath.$pathElm
  60.         set diffPath [$diffDict set $orgPath]
  61.         if {$diffPath != ""} {
  62.             set newPath $diffPath
  63.         }
  64.     }
  65.  
  66.     # build new name
  67.     set newName $newPath.$newName
  68.  
  69.     if {$name == $newName} {
  70.         puts $adjustedFid "registerObject  \{$spec\}\n"
  71.         return
  72.     } else {
  73.         $diffDict set $name $newName
  74.     }
  75.  
  76.     regsub -all {[]|*+?\().-^$[]} $name {\\&} name
  77.  
  78.     if [catch {set cnt [regsub "$name" "$spec" "$newName" newSpec]} rs] {
  79.         puts "Renaming failed for '$name': $rs"
  80.     } else {
  81.         set spec $newSpec
  82.     }
  83.  
  84.     # write the the changes file
  85.     puts $adjustedFid "registerObject  \{$spec\}\n"
  86.     if {$cnt > 0} {
  87.         global adjusted
  88.         set adjusted 1
  89.     }
  90. }
  91.  
  92. proc loadDiff {diffFile} {
  93.  
  94.     global diffDict
  95.     set diffFile [path_name concat [path_name concat \
  96.         [m4_var get M4_home] etc] $diffFile ""]
  97.     set diffDict [Dictionary new]    
  98.     if [file exists $diffFile] {
  99.         set fid [open $diffFile r]
  100.         $diffDict contents [read -nonewline $fid]
  101.         close $fid
  102.         return ""
  103.     } else {
  104.         return "'$diffFile' not found."
  105.     }
  106. }
  107.  
  108.  
  109. proc performUpgrade { custLevelObj } {
  110.  
  111.     set count 0
  112.     set reFreeze 0
  113.  
  114.     foreach name $menuList {
  115.         set custF [$custLevelObj findCustomFileVersion $name mnu]
  116.         if [$custF isNil] {
  117.             continue
  118.         }
  119.  
  120.     if { [$custF status] == "frozen" } {
  121.         if [catch {$custF unfreeze} err] {
  122.         puts "Could not unfreeze '[$custF text]' for update"
  123.         puts "Error was:"
  124.         puts $err
  125.         puts "File was not upgraded"
  126.         continue
  127.         } elseif { $err != "0" } {
  128.         puts "Could not unfreeze '[$custF text]' for update"
  129.         puts "[unkown reason]"
  130.         puts "File was not upgraded"
  131.         continue
  132.         }
  133.         set reFreeze 1
  134.     }
  135.  
  136.     if {$name == "desk"} {
  137.         set error [loadDiff diffdesk.mnu]
  138.     } else {
  139.         set error [loadDiff diffdiag.mnu]
  140.     }
  141.  
  142.     if {$error != ""} {
  143.         puts $error
  144.     }
  145.  
  146.     set adjustedFile [args_file {}]
  147.     global adjustedFid
  148.     set adjustedFid [open $adjustedFile w]
  149.     global adjusted
  150.     set adjusted 0
  151.  
  152.     set origFile [args_file {}]
  153.     $custF downLoad $origFile
  154.     sourceFile $origFile
  155.     unlink $origFile
  156.  
  157.     close $adjustedFid
  158.  
  159.     if {$adjusted == 1} {
  160.         $custF edit
  161.         $custF upLoad $adjustedFile
  162.         $custF quit
  163.         incr count
  164.     }
  165.     unlink $adjustedFile
  166.     if {$reFreeze} {
  167.         if [catch {$custF freeze "after upgrade"} err] {
  168.         puts "Could not freeze '[$custF text]' after update"
  169.         puts "Error was:"
  170.         puts $err
  171.         } elseif { $err != "0" } {
  172.         puts "Could not freeze '[$custF text]' after update"
  173.         puts "[unkown reason]
  174.         puts "File was not upgraded"
  175.         }
  176.     }
  177.     }
  178.  
  179.     return $count
  180. }
  181.  
  182. proc path2List { path } {
  183.  
  184.     set list {}
  185.     set start [string first "." $path]
  186.     if {$start == -1} {
  187.         return ""
  188.     }
  189.  
  190.     incr start 
  191.     set path "[string range $path $start end]"
  192.  
  193.     while {$path != ""} {
  194.         set end [string first "." $path]
  195.         if {$end != -1} {
  196.             incr end -1
  197.             set list "$list [string range $path 0 $end]"
  198.             incr end
  199.             incr end
  200.             set path "[string range $path $end end]"
  201.         } else {
  202.             set list "$list $path"
  203.             set path ""
  204.         }
  205.     }
  206.     return $list
  207. }
  208.  
  209. proc upgradeRepMenus {} {
  210.  
  211.     set corp [$CC currentCorporate]
  212.     set corpId [$corp identity]
  213.  
  214.     puts "Upgrading menu customization files in the repository '[$corp name]'"
  215.     puts ""
  216.  
  217.     foreach proj [$corp projects] {
  218.         $CC setLevelIds /$corpId/[$proj identity]
  219.         puts "Checking project '[$proj name]'"
  220.         set count [performUpgrade $proj]
  221.         if {$count > 0} {
  222.             puts "$count file(s) adjusted."
  223.         }
  224.         foreach cv [$proj configVersions] {
  225.             puts "   Checking config '[[$cv config] name]'"
  226.             $CC setLevelIds /$corpId/[$proj identity]/[$cv identity]
  227.             set count [performUpgrade $cv]
  228.             if {$count > 0} {
  229.                 puts "   $count file(s) adjusted."
  230.             }
  231.             foreach pv [$cv phaseVersions] {
  232.                 puts "      Checking phase '[[$pv phase ] name]'"
  233.                 $CC setLevelIds /$corpId/[$proj identity]/[$cv identity]/[$pv \
  234.                     identity]
  235.                 set count [performUpgrade $pv]
  236.                 if {$count > 0} {
  237.                     puts "      $count file(s) adjusted."
  238.                 }
  239.                 foreach sv [$pv systemVersions] {
  240.                     puts "         Checking systemVersion '[[$sv system] name]'"
  241.                     $CC setLevelIds /$corpId/[$proj identity]/[$cv \
  242.                         identity]/[$pv identity]/[$sv identity]
  243.                     set count [performUpgrade $sv]
  244.                     if {$count > 0} {
  245.                         puts "         $count file(s) adjusted."
  246.                     }
  247.                 }
  248.             }
  249.         }
  250.     }
  251.  
  252.     puts ""
  253.     puts "Upgrading menu customization files finished."
  254. }
  255.  
  256.  
  257. proc upgradeUserMenus {} {
  258.  
  259.     set icaseDir [path_name concat ~ icase]
  260.  
  261.     puts "Upgrading menu user customization files"
  262.     puts ""
  263.  
  264.     if {![file exists $icaseDir]} {
  265.         # no icaseDir == no user cust files 
  266.         puts "No user menu customization files found."
  267.         return
  268.     }
  269.  
  270.     set orgDir [pwd]
  271.     cd $icaseDir
  272.  
  273.     # save the original user customization files
  274.     foreach file $menuList {
  275.         if [file exists $icaseDir] {
  276.             cd $icaseDir
  277.             if [file exists $file.mnu] {
  278.                 puts "save $file.mnu in ${file}_4000.mnu"
  279.                 if {![file exists ${file}_4000.mnu]} {
  280.                     copy_text_file $file.mnu ${file}_4000.mnu
  281.                 }
  282.             }
  283.         }
  284.     }
  285.  
  286.     # adjust the user customization files
  287.     foreach file $menuList {
  288.         
  289.         if {![file exists $file.mnu]} {
  290.             continue
  291.         }
  292.  
  293.         puts "check file '$file.mnu'"
  294.         
  295.         if {$file == "desk"} {
  296.             set error [loadDiff diffdesk.mnu]
  297.         } else {
  298.             set error [loadDiff diffdiag.mnu]
  299.         }
  300.  
  301.         if {$error != ""} {
  302.             puts $error
  303.         }
  304.  
  305.         set adjustedFile ${file}_4001.mnu
  306.         global adjustedFid
  307.         set adjustedFid [open $adjustedFile w]
  308.         sourceFile $file.mnu
  309.         close $adjustedFid
  310.         # copy changed file to original
  311.         copy_text_file $adjustedFile $file.mnu
  312.         unlink $adjustedFile
  313.     }    
  314.  
  315.     # back to original dir
  316.     cd $orgDir
  317.  
  318.     puts ""
  319.     puts "Upgrading menu customization files finished."
  320. }
  321.  
  322. proc getName {path} {
  323.     regsub {.*\.} $path "" type
  324.     return $type
  325. }
  326.  
  327. proc sourceFile {file} {
  328.  
  329.     if [catch {
  330.         set fid [open $file]
  331.         set l [List new -contents [read $fid]]
  332.         close $fid
  333.         set end [$l length]
  334.         for {set i 1} {$i <= $end} {incr i 2} {
  335.             registerObject [$l index $i]
  336.         }
  337.     } rsn] {
  338.         wmtkerror $rsn
  339.     }
  340. }
  341.