home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # Copyright (c) 1995-1996 by Cayenne Software, 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 Cayenne Software, Inc.
- #
- #---------------------------------------------------------------------------
- #
- # File : @(#)subtdbop.tcl /main/hindenburg/3
- # Original date : December 1995
- # Description : Perform Informix TDB operations
- #
- #---------------------------------------------------------------------------
- #
-
- require machdep.tcl
-
- #
- # Return full pathname of SQL interpreter
- #
-
- proc getSqlInterpreter {} {
- if {[osIdentification] == "WIN"} {
- set infDir [get env(INFORMIXDIR) [location C: INFORMIX]]
- } else {
- set infDir [get env(INFORMIXDIR) [location /usr informix]]
- }
-
- set infBinDir [location $infDir bin]
-
- return [path_name concat $infBinDir dbaccess]
- }
-
- #
- # Create a DB
- #
-
- proc createDatabase {dbHost dbName} {
- set createSect [TextSection new]
- $createSect append "create database ${dbName}@${dbHost} with log;"
-
- return [executeCommandWithConnect $createSect $dbHost -]
- }
-
- #
- # Drop a DB
- #
-
- proc dropDatabase {dbHost dbName} {
- set dropSect [TextSection new]
- $dropSect append "drop database ${dbName}@${dbHost};"
-
- return [executeCommandWithConnect $dropSect $dbHost -]
- }
-
- #
- # Build and execute a command that connects the database
- #
-
- proc executeCommandWithConnect {sect dbHost dbName {errFile ""} {noError 0}} {
- set errMsg ""
-
- if {[osIdentification] == "WIN"} {
- set inFile [BasicFS::tmpFile]
- catch {unlink $inFile}
- set inFile ${inFile}.sql
- } else {
- set inFile -
- }
-
- #
- # If this host is equal to tdb host prevent the use of "//host" :
- # a network installation is needed for that cmd
- #
-
- if {$dbName == "-"} {
- set params "- $inFile"
- } else {
- if {[isCurrentHost $dbHost]} {
- set params "-e /$dbName $inFile"
- } else {
- set params "-e //$dbHost/$dbName $inFile"
- }
- }
-
- if {$dbHost != "" && $dbHost != [get env(INFORMIXSERVER)]} {
- global env
- set env(INFORMIXSERVER) $dbHost
- }
-
- if {[osIdentification] == "WIN"} {
- if {$errFile == ""} {
- set sqlCmd "[getSqlInterpreter] $params"
- } else {
- set sqlCmd "[getSqlInterpreter] $params > $errFile"
- }
- set fp [open $inFile w]
- } else {
- if {$errFile == ""} {
- set sqlCmd "2>@ file1 [getSqlInterpreter] $params"
- } else {
- set sqlCmd ">&$errFile [getSqlInterpreter] $params"
- }
- set fp [open "|$sqlCmd" w]
- }
-
- set errorOccurred 0
-
- if [catch {
- $sect write $fp
- close $fp
- } reason] {
- if {$noError} {
- set errMsg "$E_CAT_MON $reason"
- } else {
- m4_error $E_CAT_MON $reason
- }
- catch {close $fp}
- set errorOccurred 1
- }
-
- if {[osIdentification] == "WIN"} {
- if {!$errorOccurred} {
- if [catch {
- system "$sqlCmd"
- } reason] {
- if {$noError} {
- set errMsg "$E_CAT_MON $reason"
- } else {
- m4_error $E_CAT_MON $reason
- }
- }
- }
- catch {unlink $inFile}
- }
-
- return $errMsg
- }
-