home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / subtdbop.tcl < prev    next >
Text File  |  1997-10-14  |  4KB  |  146 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1995-1996 by Cayenne Software, Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cayenne Software, Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)subtdbop.tcl    /main/titanic/3
  17. #    Original date    : December 1995
  18. #    Description    : Perform Informix TDB operations
  19. #
  20. #---------------------------------------------------------------------------
  21. #
  22.  
  23. require machdep.tcl
  24.  
  25. #
  26. #    Return full pathname of SQL interpreter
  27. #
  28.  
  29. proc getSqlInterpreter {} {
  30.     if {[osIdentification] == "WIN"} {
  31.         set infDir [get env(INFORMIXDIR) [location C: INFORMIX]]
  32.     } else {
  33.         set infDir [get env(INFORMIXDIR) [location /usr informix]]
  34.     }
  35.  
  36.     set infBinDir [location $infDir bin]
  37.  
  38.     return [path_name concat $infBinDir dbaccess]
  39. }
  40.  
  41. #
  42. #    Create a DB
  43. #
  44.  
  45. proc createDatabase {dbHost dbName} {
  46.     set createSect [TextSection new]
  47.     $createSect append "create database ${dbName}@${dbHost} with log;"
  48.  
  49.     return [executeCommandWithConnect $createSect $dbHost -]
  50. }
  51.  
  52. #
  53. #    Drop a DB
  54. #
  55.  
  56. proc dropDatabase {dbHost dbName} {
  57.     set dropSect [TextSection new]
  58.     $dropSect append "drop database ${dbName}@${dbHost};"
  59.  
  60.     return [executeCommandWithConnect $dropSect $dbHost -]
  61. }
  62.  
  63. #
  64. #    Build and execute a command that connects the database
  65. #
  66.  
  67. proc executeCommandWithConnect {sect dbHost dbName {errFile ""} {noError 0}} {
  68.     set errMsg ""
  69.  
  70.     if {[osIdentification] == "WIN"} {
  71.         set inFile [BasicFS::tmpFile]
  72.         catch {unlink $inFile}
  73.         set inFile ${inFile}.sql
  74.     } else {
  75.         set inFile -
  76.     }
  77.  
  78.     #
  79.     # If this host is equal to tdb host prevent the use of "//host" :
  80.     # a network installation is needed for that cmd
  81.     #
  82.  
  83.     if {$dbName == "-"} {
  84.         set params "- $inFile"
  85.     } else {
  86.         if {[isCurrentHost $dbHost]} {
  87.         set params "-e $dbName $inFile"
  88.         } else {
  89.         set params "-e $dbHost@$dbName $inFile"
  90.         }
  91.     }
  92.  
  93.     if {$dbHost != "" && $dbHost != [get env(INFORMIXSERVER)]} {
  94.         global env
  95.         set env(INFORMIXSERVER) $dbHost
  96.     }
  97.  
  98.     if {[osIdentification] == "WIN"} {
  99.         if {$errFile == ""} {
  100.         set sqlCmd "[getSqlInterpreter] $params"
  101.         } else {
  102.         set sqlCmd "[getSqlInterpreter] $params > $errFile"
  103.         }
  104.         set fp [open $inFile w]
  105.     } else {
  106.         if {$errFile == ""} {
  107.         set sqlCmd "2>@ file1 [getSqlInterpreter] $params"
  108.         } else {
  109.         set sqlCmd ">&$errFile [getSqlInterpreter] $params"
  110.         }
  111.         set fp [open "|$sqlCmd" w]
  112.     }
  113.  
  114.     set errorOccurred 0
  115.  
  116.     if [catch {
  117.         $sect write $fp
  118.         close $fp
  119.     } reason] {
  120.         if {$noError} {
  121.         set errMsg "$E_CAT_MON $reason"
  122.         } else {
  123.         m4_error $E_CAT_MON $reason
  124.         }
  125.         catch {close $fp}
  126.         set errorOccurred 1
  127.     }
  128.  
  129.     if {[osIdentification] == "WIN"} {
  130.         if {!$errorOccurred} {
  131.         if [catch {
  132.             system "$sqlCmd"
  133.         } reason] {
  134.             if {$noError} {
  135.             set errMsg "$E_CAT_MON $reason"
  136.             } else {
  137.             m4_error $E_CAT_MON $reason
  138.             }
  139.         }
  140.         }
  141.         catch {unlink $inFile}
  142.     }
  143.  
  144.     return $errMsg
  145. }
  146.