home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / gensqlomt.tcl < prev    next >
Text File  |  1996-06-05  |  3KB  |  117 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1993-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        : @(#)gensqlomt.tcl    2.1
  17. #    Author        : frmo
  18. #    Original date    : 27-7-1993
  19. #    Description    : OMT specific target independent gensql procedures
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. proc gensql_omt {} {
  25.     global model oomodel
  26.  
  27.     set tgt_files {
  28.         create.sql_script create_procs.sql_script
  29.         create_tables.sql_script drop.sql_script drop_procs.sql_script
  30.         drop_tables.sql_script
  31.     }
  32.  
  33.     set cc [ClientContext::global]
  34.     set proj [$cc currentProject]
  35.     set configV [$cc currentConfig]
  36.     set phaseV [$cc currentPhase]
  37.     set systemV [$cc currentSystem]
  38.  
  39.     if {![$proj isNil] } {
  40.         set projName [$proj name]
  41.     }
  42.  
  43.     if {![$configV isNil] } {
  44.         set configName [[$configV config] name]
  45.     }
  46.  
  47.     if {![$phaseV isNil] } {
  48.         set phaseName [[$phaseV phase] name]
  49.     }
  50.  
  51.     if {![$systemV isNil] } {
  52.         set systemName [[$systemV system] name]
  53.     }
  54.  
  55.     foreach tgt $tgt_files {
  56.  
  57.                 # Can't do this test since after import-new new persistent
  58.                 # classes may be present which cause most of these scripts
  59.                 # to be invalid.
  60.                 #
  61.         # if {($import_new && [fstorage::exists $tgt])}
  62.  
  63.                 if {$import_sel && [lsearch [get_tgt_objs] $tgt] == -1} {
  64.             continue
  65.         }
  66.         set name [nt_get_name $tgt]
  67.         set sect [TextSection new]
  68.  
  69.         expand_file $sect [m4_path_name etc $name.hdr] filename $name \
  70.             proj $proj \
  71.             configV [$configV versionNumber] \
  72.             phaseV [$phaseV versionNumber]\
  73.             systemV [$systemV versionNumber]\
  74.             projName $projName \
  75.             configName $configName \
  76.             phaseName $phaseName \
  77.             systemName $systemName
  78.  
  79.         $sect append "\n"
  80.         gensql_for_$name $sect
  81.         # this will only work if name.hdr is constant:
  82.         #
  83.         if [section_equals_file $sect $tgt] {
  84.             puts "$tgt has not changed: file not written"
  85.             continue
  86.         }
  87.  
  88.         if {[M4CheckManager::getErrorCount] > 0} {
  89.             puts "Not saving $tgt because of previous errors"
  90.             continue
  91.         }
  92.  
  93.         m4_message  $M_CREATE_FILE $tgt
  94.         if [catch {set fd [fstorage::open $tgt w]} reason] {
  95.             puts stderr $reason
  96.             m4_error $E_UNABLE_OPEN_WRITE $tgt
  97.             continue
  98.         }
  99.         $sect write $fd
  100.         fstorage::close $fd
  101.     }
  102. }
  103.  
  104. proc gensql_for_drop {sect} {
  105.     expand_text $sect {
  106.         \~[@include drop_procs sql_script]
  107.         \~[@include drop_tables sql_script]
  108.     }
  109. }
  110.  
  111. proc gensql_for_create {sect} {
  112.     expand_text $sect {
  113.         \~[@include create_tables sql_script]
  114.         \~[@include create_procs sql_script]
  115.     }
  116. }
  117.