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

Text File | 1997-01-28 | 11.4 KB | 477 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1995 by Cadre Technologies Inc.
#
# This software is furnished under a license and may be used only in
# accordance with the terms of such license and with the inclusion of
# the above copyright notice. This software or any other copies thereof
# may not be provided or otherwise made available to any other person.
# No title to and ownership of the software is hereby transferred.
#
# The information in this software is subject to change without notice
# and should not be construed as a commitment by Cadre Technologies Inc.
#
#---------------------------------------------------------------------------
#
#    File        : @(#)impfiles.tcl    /main/hindenburg/1
#    Author        : Big Brother
#    Original date    : September 1995
#    Description    : Import files from same system in previous phase
#              Import item properties for new items
#              Overwrite descriptions is not supported, although
#              it should not be a problem to implement it using
#              the knownItems and knownQualItems lists.
#
#---------------------------------------------------------------------------
#

source    [m4_path_name tcl cginit.tcl]

require    platform.tcl

Class FileImporter : GCObject {
    #
    # Context stuff
    #
    attribute cc
    attribute currConfigV
    attribute currPhaseV
    attribute prevPhaseV
    attribute currSysV
    attribute prevSysV
    #
    # Overwrite properties ?
    #
    attribute overwriteProperties
    #
    # List of selected file id's in current system
    #
    attribute selectedFileList
    #
    # List of file versions to import
    #
    attribute importFileVList
    #
    # List of all items referred in files that we have to import and are
    # defined in the system the file is in.
    #
    attribute itemList
    #
    # Lists of all normal and all qualified items from itemList that do not
    # exist in the phase we are importing to
    #
    attribute newItems
    attribute newQualItems
    #
    # List of all normal and all qualified items from itemList that exist in
    # the phase we are importing to
    #
    attribute knownItems
    attribute knownQualItems

    constructor

    method initialize
    method listNewFiles
    method listSelectedFiles
    method buildItemList
    method findItem
    method findQualifiedItem
    method import
    method importFiles
    method importItemProperties
    method overwriteItemProperties
}

constructor FileImporter {class object} {
    set this [GCObject::constructor $class $object]

    $this overwriteProperties 0

    $this itemList [List new]
    $this newItems [List new]
    $this newQualItems [List new]
    $this knownItems [List new]
    $this knownQualItems [List new]

    return $this
}

method FileImporter::initialize {this files} {
    if {($files != "") && ([lindex $files 0] == "-overwrite")} {
    lvarpop files
    $this overwriteProperties 1
    }

    $this selectedFileList $files

    $this cc [ClientContext::global]
    $this currSysV [[$this cc] currentSystem]

    if {[[$this currSysV] isNil]} {
    error "Not at system level"
    }

    $this currConfigV [[$this cc] currentConfig]
    $this currPhaseV [[$this cc] currentPhase]

    if {[[[$this currPhaseV] phase] type] == "Implementation"} {
    error "Cannot copy files to implementation phase"
    }

    $this prevPhaseV [[$this currPhaseV] previous [$this currConfigV]]

    if {[[$this prevPhaseV] isNil]} {
    error "Previous phase version not found"
    }

    set sysName [[[$this currSysV] system] name]
    set sysType [[[$this currSysV] system] type]

    $this prevSysV [[$this prevPhaseV] findSystemVersion $sysName $sysType]

    if {[[$this prevSysV] isNil]} {
    error "Unable to find system '$sysName.$sysType' in previous phase"
    }

    if {[$this selectedFileList] == ""} {
    #
    # Import new: build a list of all new files
    #

    $this listNewFiles
    } else {
    $this listSelectedFiles
    }

    $this buildItemList
}

#
#    Build a list of all files that exist in previous system but not in
#    current system
#

method FileImporter::listNewFiles {this} {
    foreach prevFileV [[$this prevSysV] allFileVersions] {
    set fileName [[$prevFileV file] qualifiedName]
    set fileType [[$prevFileV file] type]
    if {[[[$this currSysV] findFileVersion $fileName $fileType] isNil]} {
        if {[$prevFileV status] == "reused"} {
        puts stdout "Skipping file $fileName.$fileType (reused)"
        } else {
        $this importFileVList [concat [$this importFileVList] $prevFileV]
        }
    }
    }
}

#
#    Build a list of all files in the previous phase corresponding to the
#    selected files in the current system
#

method FileImporter::listSelectedFiles {this} {
    foreach fileId [$this selectedFileList] {
    set currFile [File new $fileId]

    if {[$currFile isNil]} {
        puts stdout "File with id '$fileId' not found"
        continue
    }

    set fileName [$currFile qualifiedName]
    set fileType [$currFile type]

    set prevFileV [[$this prevSysV] findFileVersion $fileName $fileType]

    if {[$prevFileV isNil]} {
        puts stdout "File '$fileName.$fileType' not found in previous phase"
        continue
    }

    $this importFileVList [concat [$this importFileVList] $prevFileV]
    }
}

#
#    Build lists of items that are defined in the system we are copying
#    from and that are referred in the diagrams we are copying.
#    Items with scope 'scopeFile' are not interesting because their
#    properties are copied together with the file.
#

method FileImporter::buildItemList {this} {
    foreach fileV [$this importFileVList] {
    foreach workItem [$fileV definedItemRefs [$this currConfigV]] {
        if {[$workItem scope] != "scopeFile" &&
        [lsearch [[$this itemList] contents] $workItem] == -1} {
        [$this itemList] append $workItem
        }
    }
    }

    #
    # Check if item already exists in system we are importing to.
    # If it already exists add it to one of the knownItems lists,
    # otherwise to one of the newItems lists.
    #

    [$this itemList] foreach workItem {
    set name [$workItem name]
    set type [$workItem type]
    set qualifier [[$workItem item] qualifier]

    if [$qualifier isNil] {
        set otherItem [$this findItem $name $type]

        if [$otherItem isNil] {
        [$this newItems] append $workItem
        } else {
        [$this knownItems] append $workItem
        }
    } else {
        set otherItem [$this findQualifiedItem $qualifier $name $type]

        if [$otherItem isNil] {
        [$this newQualItems] append $workItem
        } else {
        [$this knownQualItems] append $workItem
        }
    }
    }
}

#
#    Look for an item in the system we are importing to.
#

method FileImporter::findItem {this name type} {
    return [[$this currSysV] findDefinition $name $type [$this currConfigV]]
}

#
#    Look for a qualified item in the system we are importing to.
#

method FileImporter::findQualifiedItem {this qualifier name type} {
    #
    # Find the qualifying item in current system
    #

    set qualItem [$this findItem [$qualifier name] [$qualifier type]]

    if [$qualItem isNil] {
    return $qualItem
    }

    set sysV [$this currSysV]
    set configV [$this currConfigV]

    return [$sysV findDefinition [$qualItem item] $name $type $configV]
}

method FileImporter::import {this} {
    $this importFiles

    if {([[$this newItems] contents] != "") ||
    ([[$this newQualItems] contents] != "")} {
    $this importItemProperties
    }

    if [$this overwriteProperties] {
    $this overwriteItemProperties
    }
}

#
#    Copy file from previous system to current system
#

method FileImporter::importFiles {this} {
    foreach fileV [$this importFileVList] {
    set fileName [[$fileV file] qualifiedName]
    set fileType [[$fileV file] type]

    set confV [$this currConfigV]
    set sysV [$this currSysV]

    puts stdout "Copying file '$fileName.$fileType'"

    if {[catch {$sysV copy -fileVersion $fileV $confV} reason]} {
        puts stdout "Copy failed: $reason"
    } else {
        puts stdout "Copy succeeded"
    }
    }
}

#
# Import item properties for new items
#

method FileImporter::importItemProperties {this} {

    puts stdout "Importing item properties for new items"

    set sysV [$this currSysV]

    #
    # First copy properties for non qualified items
    #

    [$this newItems] foreach workItem {
    set name [$workItem name]
    set type [$workItem type]

    set other [$this findItem $name $type]

    if [$other isNil] {
        set scope [$workItem scope]

        set other [$sysV declareItem $name $type $scope]

        if [$other isNil] {
        error "Unable to create item '$name.$type' with scope $scope"
        }
    }

    set oldProps [$workItem properties]
    set newProps [$other properties]

    foreach prop [$oldProps properties] {
        $newProps setProperty [$prop name] [$prop value]
    }
    }

    #
    # Now copy properties for qualified items
    #

    [$this newQualItems] foreach workItem {
    set name [$workItem name]
    set type [$workItem type]
    set qualifier [[$workItem item] qualifier]

    set other [$this findQualifiedItem $qualifier $name $type]

    if [$other isNil] {
        set qual [$this findItem [$qualifier name] [$qualifier type]]

        if [$qual isNil] {
        continue
        }

        set scope [$workItem scope]

        set other [$sysV declareItem [$qual item] $name $type $scope]

        if [$other isNil] {
        error "Unable to create item '$name.$type' with scope $scope"
        }
    }

    set oldProps [$workItem properties]
    set newProps [$other properties]

    foreach prop [$oldProps properties] {
        $newProps setProperty [$prop name] [$prop value]
    }
    }

    puts stdout "Done"
}

#
# Overwrite item properties of existing items
#

method FileImporter::overwriteItemProperties {this} {

    #
    # Overwrite properties for existing non qualified items
    #

    puts stdout "Overwriting item properties for existing items"

    [$this knownItems] foreach workItem {
    set name [$workItem name]
    set type [$workItem type]

    set other [$this findItem $name $type]

    if [$other isNil] {
        error "Unable to find item '$name.$type' with scope $scope"
    }

    set oldProps [$workItem properties]
    set newProps [$other properties]

    #
    # Remove existing properties
    #

    foreach prop [$newProps properties] {
        $newProps removeProperty [$prop name]
    }

    #
    # Copy new properties
    #

    foreach prop [$oldProps properties] {
        $newProps setProperty [$prop name] [$prop value]
    }
    }

    #
    # Now copy properties for existing qualified items
    #

    [$this knownQualItems] foreach workItem {
    set name [$workItem name]
    set type [$workItem type]
    set qualifier [[$workItem item] qualifier]

    set other [$this findQualifiedItem $qualifier $name $type]

    if [$other isNil] {
        error "Unable to qualified find item '$name.$type' with scope $scope"
    }

    set oldProps [$workItem properties]
    set newProps [$other properties]

    #
    # Remove existing properties
    #

    foreach prop [$newProps properties] {
        $newProps removeProperty [$prop name]
    }

    #
    # Copy new properties
    #

    foreach prop [$oldProps properties] {
        $newProps setProperty [$prop name] [$prop value]
    }
    }

    puts stdout "Done"
}

#
# Create a FileImporter instance, initialize it and import ...
#

global argv

set importer [FileImporter new]

if [catch {$importer initialize $argv; $importer import} myMessage] {
    puts stderr $myMessage
}