home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # 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 : @(#)impsystems.tcl /main/hindenburg/1
- # Author : Big Brother
- # Original date : September 1995
- # Description : Import systems from previous phase
- #
- #---------------------------------------------------------------------------
- #
-
- source [m4_path_name tcl cginit.tcl]
-
- require platform.tcl
-
- proc importSystems {} {
- global argv
- set cc [ClientContext::global]
- set systemList $argv
- set argv ""
-
- set currPhaseV [$cc currentPhase]
-
- if [$currPhaseV isNil] {
- puts stdout "Not at phase level"
- return
- }
-
- set prevPhaseV [$currPhaseV previous [$cc currentConfig]]
-
- if [$prevPhaseV isNil] {
- puts stdout "Previous phase version not found"
- return
- }
-
- while {![[$cc currentSystem] isNil]} {
- $cc upLevel
- }
-
- if {$systemList == ""} {
- return [importNewSystems $cc $prevPhaseV]
- }
-
- foreach sysId $systemList {
- set prevSystem [System new $sysId]
-
- if [$prevSystem isNil] {
- puts stdout "System with id '$sysId' not found"
- continue
- }
-
- set prevSysV [$prevSystem selectedVersion [$cc currentConfig]]
-
- if {[[$currPhaseV phase] type] == "Implementation"} {
- importSpecifiedSystem $cc $prevSysV
- } else {
- copySpecifiedSystem $cc $prevSysV
- }
- }
- }
-
- #
- # Import systems that exist in previous phase but not in current phase
- #
-
- proc importNewSystems {cc prevPhaseV} {
- set currPhaseV [$cc currentPhase]
-
- foreach prevSysV [$prevPhaseV systemVersions] {
- set prevSystem [$prevSysV system]
-
- if {[$prevSystem type] == "system"} {
- set sysName [$prevSystem name]
-
- if [[$currPhaseV findSystemVersion $sysName system] isNil] {
- if {[[$currPhaseV phase] type] == "Implementation"} {
- importSpecifiedSystem $cc $prevSysV
- } else {
- copySpecifiedSystem $cc $prevSysV
- }
- }
- }
- }
- }
-
- #
- # Copy system from previous phase to current phase
- #
-
- proc copySpecifiedSystem {cc prevSysV} {
- set sysName [[$prevSysV system] name]
- set currPhaseV [$cc currentPhase]
- set currConfV [$cc currentConfig]
-
- puts stdout ""
- puts stdout "Copying system '$sysName'"
-
- if {[catch {$currPhaseV copy -systemVersion $prevSysV $currConfV} reason]} {
- puts stdout "Copy failed: $reason"
- } else {
- puts stdout "Copy succeeded"
- }
- }
-
- #
- # Import specified system to Implementation phase
- #
-
- proc importSpecifiedSystem {cc prevSysV} {
- set sysName [[$prevSysV system] name]
- set currConfV [$cc currentConfig]
- set currPhaseV [$cc currentPhase]
-
- set newSysV [$currPhaseV createSystemVersion $sysName cl system $currConfV]
- $cc downLevelId $newSysV
-
- puts stdout ""
- puts stdout "Importing system '$sysName'"
- puts stdout ""
-
- global src_objects; set src_objects "oopl sql"
- global tgt_objects; set tgt_objects ""
-
- require_with_reload import.tcl
-
- puts stdout ""
- puts stdout "Finished importing system '$sysName'"
- puts stdout ""
-
- while {![[$cc currentSystem] isNil]} {
- $cc upLevel
- }
- }
-
- #
- # Just call importSystems
- #
-
- if [catch {importSystems}] {
- puts stderr $errorInfo
- }
-