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 >
Wrap
Text File
|
1996-06-05
|
4KB
|
148 lines
#---------------------------------------------------------------------------
#
# Copyright (c) 1992-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 : @(#)gensql.tcl 2.1
# Original date : 27-8-1992
# Description : ANSI SQL GEN
#
#---------------------------------------------------------------------------
#
#---------------------------------------------------------------------------
#
# Include general tcl scripts
#
#---------------------------------------------------------------------------
require wmt_util.tcl
require libsql.tcl
require gensqlomt.tcl
#---------------------------------------------------------------------------
#
# CREATE & DROP PROCEDURES
#
#---------------------------------------------------------------------------
# Generate a create table script for each table
#
proc create_tables { current_section model } {
m4_message $M_GEN_C_TAB
foreach currtab [$model tableSet] {
set tab_name [$currtab getUniqueName]
$current_section pushIndent
expand_text $current_section {
/*
* Create table for '~$tab_name'
*/
CREATE TABLE ~$tab_name
(
~[gen_data_decl_4gl $current_section $currtab "ALL" " ,\n"]
)
}
$current_section popIndent
}
}
# Generate drop table script for each table
#
proc drop_tables { current_section model } {
m4_message $M_GEN_D_TAB
foreach currtab [$model tableSet] {
set tab_name [$currtab getUniqueName]
$current_section pushIndent
expand_text $current_section {
/*
* Drop table for '~$tab_name'
*/
DROP TABLE ~$tab_name
}
$current_section popIndent
}
}
set cc [ClientContext::global]
if {[$cc customFileExists u_gensql tcl "" 0]} {
require u_gensql.tcl
}
# Determine the sql_postfix for a column. I.e. add "NOT NULL"
#
proc modify_sql_postfix {col} {
if {![$col isNullable]} {
$col addRunTimeProperty sql_postfix "NOT NULL"
}
}
# This procedure is called from the gensql defined in libsql.tcl
#
proc before_gensql { model } {
foreach currtab [$model tableSet] {
foreach col [$currtab columnSet] {
modify_sql_postfix $col
}
}
}
#
# Procedures to generate the contents of SQL scripts. Each procedures is
# names after the script as follows: gensql_for_<script_name>
#
proc gensql_for_create_procs {sect} {
global model
gen_includes $sect $model create_procs sql_script
$sect append "\n"
}
proc gensql_for_create_tables {sect} {
global model
gen_includes $sect $model create_tables sql_script
$sect append "\n"
create_tables $sect $model
}
proc gensql_for_drop_procs {sect} {
global model
gen_includes $sect $model drop_procs sql_script
$sect append "\n"
}
proc gensql_for_drop_tables {sect} {
global model
gen_includes $sect $model drop_tables sql_script
$sect append "\n"
drop_tables $sect $model
}
#---------------------------------------------------------------------------
#
# AUTOSTART OF GENSQL
#
#---------------------------------------------------------------------------
#
# NOTE: Do not move this line to another place, else the generator
# will not work at all!!
#
if [catch {gensql}] {
puts stderr $errorInfo
}