PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/checkall.tcl

Text File | 1996-08-12 | 12KB | 321 lines

#              ~/icase/check_all.tcl
#
# Created: 18 march 1996
# Updated: 18 april 1996
# Version: 1.2
# Purpose: To check all diagrams from the current level downwards
# Arguments: either 'contents', 'local' or 'global'.
#            passed on to tcl using the '--' method.
# Notes on V1.1: Added global model check support.
# Notes on V1.2: Added MS-DOS support (awk differences)
#

#puts "Using ~/icase/check_all.tcl"

# -------------------------
# get the require procedure
# -------------------------
source "[m4_path_name tcl libocl.tcl]"

# --------------------------------
# to get the global variable win95
# --------------------------------
require platform.tcl


proc usage {} {
    puts "Usage: otsh ~/icase/check_all.tcl -- ( contents | local | global )"
    exit 1
}


# -------------------------------------------------------
# sort script to sort a list of handles according to name
# -------------------------------------------------------
proc sortHandles { handles prefix extractName } {
    # --------------------------
    # Handle the empty list case
    # --------------------------
    if { ! [llength $handles] } {
        return {}
    }

    # ----------------------------------------
    # extract all names and put them in a list
    # ----------------------------------------
    foreach handle $handles {
        set name "[eval $prefix $handle $extractName]"
        lappend handleNameList $name
    }

    # --------------------------
    # sort the names in the list
    # --------------------------
    set handleNameList [lsort $handleNameList]

    # --------------------------------------------
    # replace each name with the associated handle
    # --------------------------------------------
    foreach handle $handles {
        set name "[eval $prefix $handle $extractName]"
        set index [lsearch $handleNameList $name]
        set handleNameList [lreplace $handleNameList $index $index $handle]
    }

    # -------------------------------------------------------
    # return the handle lists sorted according to their names
    # -------------------------------------------------------
    return "$handleNameList"
}


# ------------------------------------------------------------
# Iterate over all systems in a phase and diagrams in a system
# ------------------------------------------------------------

proc checkSystems { systems level } {
    global ucgargv
    global EXE_EXT

    # -----------------------------------------------------
    # some global to this function variable initializations
    # -----------------------------------------------------
    set command [m4_path_name bin otsh$EXE_EXT]
    #set command [m4_path_name bin otsh]
    set awk "'\$1!=\"Otsh\"{if(n==NR-1)print \"      > \" \$0;n=NR}'"
    if { ! $win95 } {
        set awk "2>&1 | awk $awk"
    } else {
        # -----------------------------------------------------
        # NOTE: The PC version of tcl doesn't (yet) allow pipes
        # -----------------------------------------------------
        #set awk "g:/gnu/bin/gawk.exe $awk"
        set awk ""
    }

    # ------------------------
    # iterate over all systems
    # ------------------------
    set systems [ sortHandles $systems "\[" "system\] name" ]
    foreach system $systems {
        set type [[$system system] type]
        set sys_name [[$system system] name]
        set path "$level/$sys_name.system"

        # -----------------------------
        # Feedback progress to the user
        # -----------------------------
        puts "      Checking $ucgargv of system '$sys_name'"

        # --------------------------------------------------------------
        # get the next system if it's not a real system (e.g.: document)
        # --------------------------------------------------------------
        if { $type != "system" } {
            puts "      >"
            puts "      > System '$sys_name' of type '$type', nothing checked"
            puts "      >"
            puts "      Finished checking $ucgargv of system '$sys_name'\n"
            continue;
        }

        # --------------
        # Error handling
        # --------------
        set ok "[[ClientContext::global] setLevelPath $path]"
        if { $ok } {
            puts " Can't determine client context: '$env(M4_levelpath)'"
            puts " Program stops, without checking this local local."
            exit 1
        }

        if { $ucgargv == "global" } {
            system "$command -f check.tcl -- -global $awk"
        } else {
            # ----------------------------------------------
            # gather all diagrams and check them all at once
            # ----------------------------------------------
            set diagrams {}
            set localFiles [$system localFileVersions]
            foreach diagram $localFiles {
                if { [string first "@Graph:" "$diagram"] == 0 } {
                    set name [[$diagram file] qualifiedName]
                    set type [[$diagram file] type]

                    # --------------------------------------------------------
                    # differ between contents and local model argument passing
                    # --------------------------------------------------------
                    if { $ucgargv == "contents" } {
                        lappend diagrams "$name.$type"
                    } else {
                        lappend diagrams "-S $name.$type"
                    }
                }
            }

            # ----------------------------------------------
            # sort the diagrams according to name (and type)
            # ----------------------------------------------
            set diagrams [join [lsort $diagrams]]

            # -------------------------------------------
            # check if there is something to check at all
            # -------------------------------------------
            if { [llength $diagrams] } {
                # -----------------------------------------------------------
                # check contents and local local have different command lines
                # -----------------------------------------------------------
                if { $ucgargv == "contents" } {
                    system "$command -c $diagrams $awk"
                } else {
                    system "$command $diagrams -f check.tcl $awk"
                }
            } else {
                puts "      >"
                puts "      > System '$sys_name' empty, nothing checked"
                puts "      >"
            }
        }
        puts "      Finished checking $ucgargv of system '$sys_name'\n"
    }
}


# ------------------------------------------
# Iterate over all phases in a configuration
# ------------------------------------------

proc checkPhases { phases level } {
    set phases [sortHandles $phases "\[" "phase\] name"]
    foreach phase $phases {
        set systems [$phase systemVersions]
        set name [[$phase phase] name]
        set type [[$phase phase] type]
        puts "    Checking phase '$name.$type"
        checkSystems "$systems" "$level/$name.$type"
    }
}


# --------------------------------------------
# Iterate over all configurations in a project
# --------------------------------------------

proc checkConfigurations { configurations level } {
    set configurations [sortHandles $configurations "\[" "config\] name"]
    foreach configuration $configurations {
        set phases [$configuration phaseVersions]
        set name [[$configuration config] name]
        set version [$configuration versionNumber]
        puts "  Checking configuration '$name:$version'"
        checkPhases "$phases" "$level/$name:$version"
    }
}


# --------------------------------------------
# Iterate over all configurations in a project
# --------------------------------------------

proc checkProjects { projects level } {
    set projects [sortHandles $projects "" "name"]
    foreach project $projects {
        puts "Checking project '[$project name]'"
        set configurations [$project configVersions]
        checkConfigurations "$configurations" "$level/[$project name]"
    }
}


# --------------------------------------------------------------
# See if any boolean options were specified, set the appropriate
# variables, and remove any options from argv.
# --------------------------------------------------------------

proc checkMain {} {
    global ucgargv

    # -------------------------------------
    # A check for proper command line usage
    # -------------------------------------
    if { $ucgargv!="contents" && $ucgargv!="local" && $ucgargv!="global" } {
        usage
        exit 1;
    }

    # ------------------------------------------------------
    # Setup of variables used to walk through the level tree
    # ------------------------------------------------------
    set M4_levelpath "[[ClientContext::global] currentLevelString]"
    set clientContext [ClientContext::global]
    set corporateID [[ClientContext::global] currentCorporate]


    # -------------------------------------------------------------------------
    # set the level to the uppermost level and decend from that level downwards
    # -------------------------------------------------------------------------
    set level "/[$corporateID name]"

    # ----------------------------------------
    # if on projects level, check all projects
    # ----------------------------------------
    if { $level == $M4_levelpath } {
        set projects [$corporateID projects]
        checkProjects "$projects" "$level"
    } else {
        # --------------------------------------------------------
        # feedback message to indicate the start level to the user
        # --------------------------------------------------------
        puts "Starting check from level '$M4_levelpath'"
        set project [[$clientContext currentProject] name]

        # ----------------------------------------------------------
        # if on configurations level, check the current project only
        # ----------------------------------------------------------
        if { "$level/$project" == "$M4_levelpath" } {
            checkProjects "[$clientContext currentLevelId]" $level
        } else {
            set level "$level/$project"
            set configurationID [$clientContext currentConfig]
            set configuration "[[$configurationID config] name]"
            set configuration "$configuration:[$configurationID versionNumber]"

            # --------------------------------------------------------
            # if on phases level, check the current configuration only
            # --------------------------------------------------------
            if { "$level/$configuration" == "$M4_levelpath" } {
                checkConfigurations "[$clientContext currentLevelId]" $level
            } else {
                set level "$level/$configuration"
                set phaseID [[$clientContext currentPhase] phase]
                set phase "[$phaseID name].[$phaseID type]"

                # -------------------------------------------------
                # if on systems level, check the current phase only
                # -------------------------------------------------
                if { "$level/$phase" == "$M4_levelpath" } {

                    checkPhases "[$clientContext currentLevelId]" $level
                } else {
                    # --------------------------------------------------
                    # single system level, check the current system only
                    # --------------------------------------------------
                    set level "$level/$phase"
                    checkSystems "[$clientContext currentLevelId]" $level

                }
            }
        }
    }

    puts "check Finished"
}

# ------------------------------------------
# ugly source, should get rid of this call!!
# ------------------------------------------
global check_dont_run
if [catch {set check_dont_run}] {
    checkMain
}