home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / gensql.tcl < prev    next >
Encoding:
Text File  |  1996-06-05  |  4.0 KB  |  148 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1992-1995 by Cadre Technologies 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 Cadre Technologies Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)gensql.tcl    2.1
  17. #    Original date    : 27-8-1992
  18. #    Description    : ANSI SQL GEN
  19. #
  20. #---------------------------------------------------------------------------
  21. #
  22.  
  23. #---------------------------------------------------------------------------
  24. #
  25. # Include general tcl scripts
  26. #
  27. #---------------------------------------------------------------------------
  28. require wmt_util.tcl
  29. require libsql.tcl
  30. require gensqlomt.tcl
  31.  
  32. #---------------------------------------------------------------------------
  33. #
  34. #                       CREATE & DROP PROCEDURES
  35. #
  36. #---------------------------------------------------------------------------
  37.  
  38. # Generate a create table script for each table
  39. #
  40. proc create_tables { current_section model } {
  41.  
  42.     m4_message $M_GEN_C_TAB
  43.     foreach currtab [$model tableSet] {
  44.         set tab_name [$currtab getUniqueName]
  45.         $current_section pushIndent
  46.         expand_text $current_section {
  47.             /*
  48.              * Create table for '~$tab_name'
  49.              */
  50.             CREATE TABLE ~$tab_name
  51.             (
  52.                 ~[gen_data_decl_4gl $current_section $currtab "ALL" " ,\n"]
  53.             )
  54.  
  55.         }
  56.         $current_section popIndent
  57.     }
  58. }
  59.  
  60.  
  61. # Generate drop table script for each table
  62. #
  63. proc drop_tables { current_section model } {
  64.  
  65.     m4_message $M_GEN_D_TAB
  66.     foreach currtab [$model tableSet] {
  67.         set tab_name [$currtab getUniqueName]
  68.         $current_section pushIndent
  69.         expand_text $current_section {
  70.             /*
  71.              * Drop table for '~$tab_name'
  72.              */
  73.             DROP TABLE ~$tab_name
  74.  
  75.         }
  76.         $current_section popIndent
  77.     }
  78. }
  79.  
  80. set cc [ClientContext::global]
  81.  
  82. if {[$cc customFileExists u_gensql tcl "" 0]} {
  83.     require u_gensql.tcl
  84. }
  85.  
  86. # Determine the sql_postfix for a column. I.e. add "NOT NULL"
  87. #
  88. proc modify_sql_postfix {col} {
  89.     if {![$col isNullable]} {
  90.         $col addRunTimeProperty sql_postfix "NOT NULL"
  91.     }
  92. }
  93.  
  94. # This procedure is called from the gensql defined in libsql.tcl
  95. #
  96. proc before_gensql { model } {
  97.  
  98.     foreach currtab [$model tableSet] {
  99.     foreach col [$currtab columnSet] {
  100.         modify_sql_postfix $col
  101.     }
  102.     }
  103. }
  104.  
  105. #
  106. # Procedures to generate the contents of SQL scripts. Each procedures is
  107. # names after the script as follows: gensql_for_<script_name>
  108. #
  109.  
  110. proc gensql_for_create_procs {sect} {
  111.     global model
  112.     gen_includes $sect $model create_procs sql_script
  113.     $sect append "\n"
  114. }
  115.  
  116. proc gensql_for_create_tables {sect} {
  117.     global model
  118.     gen_includes $sect $model create_tables sql_script
  119.     $sect append "\n"
  120.     create_tables $sect $model
  121. }
  122.  
  123. proc gensql_for_drop_procs {sect} {
  124.     global model
  125.     gen_includes $sect $model drop_procs sql_script
  126.     $sect append "\n"
  127. }
  128.  
  129. proc gensql_for_drop_tables {sect} {
  130.     global model
  131.     gen_includes $sect $model drop_tables sql_script
  132.     $sect append "\n"
  133.     drop_tables $sect $model
  134. }
  135.  
  136. #---------------------------------------------------------------------------
  137. #
  138. #                         AUTOSTART OF GENSQL
  139. #
  140. #---------------------------------------------------------------------------
  141. #
  142. # NOTE: Do not move this line to another place, else the generator
  143. #       will not work at all!!
  144. #
  145. if [catch {gensql}] {
  146.     puts stderr $errorInfo
  147. }
  148.