home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / checkall.tcl < prev    next >
Encoding:
Text File  |  1996-08-12  |  12.2 KB  |  321 lines
  1. #              ~/icase/check_all.tcl
  2. #
  3. # Created: 18 march 1996
  4. # Updated: 18 april 1996
  5. # Version: 1.2
  6. # Purpose: To check all diagrams from the current level downwards
  7. # Arguments: either 'contents', 'local' or 'global'.
  8. #            passed on to tcl using the '--' method.
  9. # Notes on V1.1: Added global model check support.
  10. # Notes on V1.2: Added MS-DOS support (awk differences)
  11. #
  12.  
  13. #puts "Using ~/icase/check_all.tcl"
  14.  
  15. # -------------------------
  16. # get the require procedure
  17. # -------------------------
  18. source "[m4_path_name tcl libocl.tcl]"
  19.  
  20. # --------------------------------
  21. # to get the global variable win95
  22. # --------------------------------
  23. require platform.tcl
  24.  
  25.  
  26. proc usage {} {
  27.     puts "Usage: otsh ~/icase/check_all.tcl -- ( contents | local | global )"
  28.     exit 1
  29. }
  30.  
  31.  
  32. # -------------------------------------------------------
  33. # sort script to sort a list of handles according to name
  34. # -------------------------------------------------------
  35. proc sortHandles { handles prefix extractName } {
  36.     # --------------------------
  37.     # Handle the empty list case
  38.     # --------------------------
  39.     if { ! [llength $handles] } {
  40.         return {}
  41.     }
  42.  
  43.     # ----------------------------------------
  44.     # extract all names and put them in a list
  45.     # ----------------------------------------
  46.     foreach handle $handles {
  47.         set name "[eval $prefix $handle $extractName]"
  48.         lappend handleNameList $name
  49.     }
  50.  
  51.     # --------------------------
  52.     # sort the names in the list
  53.     # --------------------------
  54.     set handleNameList [lsort $handleNameList]
  55.  
  56.     # --------------------------------------------
  57.     # replace each name with the associated handle
  58.     # --------------------------------------------
  59.     foreach handle $handles {
  60.         set name "[eval $prefix $handle $extractName]"
  61.         set index [lsearch $handleNameList $name]
  62.         set handleNameList [lreplace $handleNameList $index $index $handle]
  63.     }
  64.  
  65.     # -------------------------------------------------------
  66.     # return the handle lists sorted according to their names
  67.     # -------------------------------------------------------
  68.     return "$handleNameList"
  69. }
  70.  
  71.  
  72. # ------------------------------------------------------------
  73. # Iterate over all systems in a phase and diagrams in a system
  74. # ------------------------------------------------------------
  75.  
  76. proc checkSystems { systems level } {
  77.     global ucgargv
  78.     global EXE_EXT
  79.  
  80.     # -----------------------------------------------------
  81.     # some global to this function variable initializations
  82.     # -----------------------------------------------------
  83.     set command [m4_path_name bin otsh$EXE_EXT]
  84.     #set command [m4_path_name bin otsh]
  85.     set awk "'\$1!=\"Otsh\"{if(n==NR-1)print \"      > \" \$0;n=NR}'"
  86.     if { ! $win95 } {
  87.         set awk "2>&1 | awk $awk"
  88.     } else {
  89.         # -----------------------------------------------------
  90.         # NOTE: The PC version of tcl doesn't (yet) allow pipes
  91.         # -----------------------------------------------------
  92.         #set awk "g:/gnu/bin/gawk.exe $awk"
  93.         set awk ""
  94.     }
  95.  
  96.     # ------------------------
  97.     # iterate over all systems
  98.     # ------------------------
  99.     set systems [ sortHandles $systems "\[" "system\] name" ]
  100.     foreach system $systems {
  101.         set type [[$system system] type]
  102.         set sys_name [[$system system] name]
  103.         set path "$level/$sys_name.system"
  104.  
  105.         # -----------------------------
  106.         # Feedback progress to the user
  107.         # -----------------------------
  108.         puts "      Checking $ucgargv of system '$sys_name'"
  109.  
  110.         # --------------------------------------------------------------
  111.         # get the next system if it's not a real system (e.g.: document)
  112.         # --------------------------------------------------------------
  113.         if { $type != "system" } {
  114.             puts "      >"
  115.             puts "      > System '$sys_name' of type '$type', nothing checked"
  116.             puts "      >"
  117.             puts "      Finished checking $ucgargv of system '$sys_name'\n"
  118.             continue;
  119.         }
  120.  
  121.         # --------------
  122.         # Error handling
  123.         # --------------
  124.         set ok "[[ClientContext::global] setLevelPath $path]"
  125.         if { $ok } {
  126.             puts " Can't determine client context: '$env(M4_levelpath)'"
  127.             puts " Program stops, without checking this local local."
  128.             exit 1
  129.         }
  130.  
  131.         if { $ucgargv == "global" } {
  132.             system "$command -f check.tcl -- -global $awk"
  133.         } else {
  134.             # ----------------------------------------------
  135.             # gather all diagrams and check them all at once
  136.             # ----------------------------------------------
  137.             set diagrams {}
  138.             set localFiles [$system localFileVersions]
  139.             foreach diagram $localFiles {
  140.                 if { [string first "@Graph:" "$diagram"] == 0 } {
  141.                     set name [[$diagram file] qualifiedName]
  142.                     set type [[$diagram file] type]
  143.     
  144.                     # --------------------------------------------------------
  145.                     # differ between contents and local model argument passing
  146.                     # --------------------------------------------------------
  147.                     if { $ucgargv == "contents" } {
  148.                         lappend diagrams "$name.$type"
  149.                     } else {
  150.                         lappend diagrams "-S $name.$type"
  151.                     }
  152.                 }
  153.             }
  154.     
  155.             # ----------------------------------------------
  156.             # sort the diagrams according to name (and type)
  157.             # ----------------------------------------------
  158.             set diagrams [join [lsort $diagrams]]
  159.     
  160.             # -------------------------------------------
  161.             # check if there is something to check at all
  162.             # -------------------------------------------
  163.             if { [llength $diagrams] } {
  164.                 # -----------------------------------------------------------
  165.                 # check contents and local local have different command lines
  166.                 # -----------------------------------------------------------
  167.                 if { $ucgargv == "contents" } {
  168.                     system "$command -c $diagrams $awk"
  169.                 } else {
  170.                     system "$command $diagrams -f check.tcl $awk"
  171.                 }
  172.             } else {
  173.                 puts "      >"
  174.                 puts "      > System '$sys_name' empty, nothing checked"
  175.                 puts "      >"
  176.             }
  177.         }
  178.         puts "      Finished checking $ucgargv of system '$sys_name'\n"
  179.     }
  180. }
  181.  
  182.  
  183. # ------------------------------------------
  184. # Iterate over all phases in a configuration
  185. # ------------------------------------------
  186.  
  187. proc checkPhases { phases level } {
  188.     set phases [sortHandles $phases "\[" "phase\] name"]
  189.     foreach phase $phases {
  190.         set systems [$phase systemVersions]
  191.         set name [[$phase phase] name]
  192.         set type [[$phase phase] type]
  193.         puts "    Checking phase '$name.$type"
  194.         checkSystems "$systems" "$level/$name.$type"
  195.     }
  196. }
  197.  
  198.  
  199. # --------------------------------------------
  200. # Iterate over all configurations in a project
  201. # --------------------------------------------
  202.  
  203. proc checkConfigurations { configurations level } {
  204.     set configurations [sortHandles $configurations "\[" "config\] name"]
  205.     foreach configuration $configurations {
  206.         set phases [$configuration phaseVersions]
  207.         set name [[$configuration config] name]
  208.         set version [$configuration versionNumber]
  209.         puts "  Checking configuration '$name:$version'"
  210.         checkPhases "$phases" "$level/$name:$version"
  211.     }
  212. }
  213.  
  214.  
  215. # --------------------------------------------
  216. # Iterate over all configurations in a project
  217. # --------------------------------------------
  218.  
  219. proc checkProjects { projects level } {
  220.     set projects [sortHandles $projects "" "name"]
  221.     foreach project $projects {
  222.         puts "Checking project '[$project name]'"
  223.         set configurations [$project configVersions]
  224.         checkConfigurations "$configurations" "$level/[$project name]"
  225.     }
  226. }
  227.  
  228.  
  229. # --------------------------------------------------------------
  230. # See if any boolean options were specified, set the appropriate
  231. # variables, and remove any options from argv.
  232. # --------------------------------------------------------------
  233.  
  234. proc checkMain {} {
  235.     global ucgargv
  236.  
  237.     # -------------------------------------
  238.     # A check for proper command line usage
  239.     # -------------------------------------
  240.     if { $ucgargv!="contents" && $ucgargv!="local" && $ucgargv!="global" } {
  241.         usage
  242.         exit 1;
  243.     }
  244.         
  245.     # ------------------------------------------------------
  246.     # Setup of variables used to walk through the level tree
  247.     # ------------------------------------------------------
  248.     set M4_levelpath "[[ClientContext::global] currentLevelString]"
  249.     set clientContext [ClientContext::global]
  250.     set corporateID [[ClientContext::global] currentCorporate]
  251.  
  252.  
  253.     # -------------------------------------------------------------------------
  254.     # set the level to the uppermost level and decend from that level downwards
  255.     # -------------------------------------------------------------------------
  256.     set level "/[$corporateID name]"
  257.  
  258.     # ----------------------------------------
  259.     # if on projects level, check all projects
  260.     # ----------------------------------------
  261.     if { $level == $M4_levelpath } {
  262.         set projects [$corporateID projects]
  263.         checkProjects "$projects" "$level"
  264.     } else {
  265.         # --------------------------------------------------------
  266.         # feedback message to indicate the start level to the user
  267.         # --------------------------------------------------------
  268.         puts "Starting check from level '$M4_levelpath'"
  269.         set project [[$clientContext currentProject] name]
  270.  
  271.         # ----------------------------------------------------------
  272.         # if on configurations level, check the current project only
  273.         # ----------------------------------------------------------
  274.         if { "$level/$project" == "$M4_levelpath" } {
  275.             checkProjects "[$clientContext currentLevelId]" $level
  276.         } else {
  277.             set level "$level/$project"
  278.             set configurationID [$clientContext currentConfig]
  279.             set configuration "[[$configurationID config] name]"
  280.             set configuration "$configuration:[$configurationID versionNumber]"
  281.  
  282.             # --------------------------------------------------------
  283.             # if on phases level, check the current configuration only
  284.             # --------------------------------------------------------
  285.             if { "$level/$configuration" == "$M4_levelpath" } {
  286.                 checkConfigurations "[$clientContext currentLevelId]" $level
  287.             } else {
  288.                 set level "$level/$configuration"
  289.                 set phaseID [[$clientContext currentPhase] phase]
  290.                 set phase "[$phaseID name].[$phaseID type]"
  291.  
  292.                 # -------------------------------------------------
  293.                 # if on systems level, check the current phase only
  294.                 # -------------------------------------------------
  295.                 if { "$level/$phase" == "$M4_levelpath" } {
  296.  
  297.                     checkPhases "[$clientContext currentLevelId]" $level
  298.                 } else {
  299.                     # --------------------------------------------------
  300.                     # single system level, check the current system only
  301.                     # --------------------------------------------------
  302.                     set level "$level/$phase"
  303.                     checkSystems "[$clientContext currentLevelId]" $level
  304.  
  305.                 }
  306.             }
  307.         }
  308.     }
  309.  
  310.     puts "check Finished"
  311. }
  312.  
  313. # ------------------------------------------
  314. # ugly source, should get rid of this call!!
  315. # ------------------------------------------
  316. global check_dont_run
  317. if [catch {set check_dont_run}] {
  318.     checkMain 
  319. }
  320.  
  321.