home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # 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 : @(#)libmss.tcl /main/hindenburg/1
- # Original date : November 1994
- # Description : Special procedures for the SQLServer target
- #
- #---------------------------------------------------------------------------
- #
- # @(#)libmss.tcl /main/hindenburg/1 13 Mar 1997 Copyright 1992-1995 Cadre Technologies Inc.
- #
- #---------------------------------------------------------------------------
- require {mssql_msg.tcl}
-
- #
- # Add extra column_selectors for target mss
- #
- global column_selector
- set column_selector(SERIAL) {([$col getTypeStd] == "serial" &&
- [$col get_obj_type] != "imp_column")}
- set column_selector(ALL_NONSERIAL) {[$col getTypeStd] != "serial" ||
- [$col get_obj_type] == "imp_column"}
- set column_selector(NONKEYS_NONSERIAL) {[$col getColumnType] != "key" &&
- ([$col getTypeStd] != "serial" ||
- [$col get_obj_type] == "imp_column")}
- set column_selector(NONKEYFIELDS_NONSERIAL) {[$col get_obj_type] == "column" &&
- [$col getColumnType] != "key" &&
- [$col getTypeStd] != "serial"}
-
- #
- # Global extra binding table
- #
- global bindingTable
- set bindingTable [DbBindTab::createTable]
-
- proc get_bind_typestd { typeStd } {
- set handle [$bindingTable getBinding $typeStd]
- if { $handle == "" } {
- m4_error $E_NOBINDENT $typeStd
- set handle [$bindingTable getBinding "integer"]
- if { $handle == "" } {
- set handle [$bindingTable getBinding "int"]
- if { $handle == "" } {
- m4_fatal $F_NODEFBIND
- }
- }
- }
- return $handle
- }
-
- proc get_bind_entry { column } {
- set type [$column getTypeStd]
- if { [regsub {([^[]+)\[[0-9]*\]} $type {\1} typeStd] } {
- set typeStd "${typeStd}\[\]"
- }
- return [get_bind_typestd $typeStd]
- }
-
- proc get_format_char { column } {
- return [[get_bind_entry $column] format]
- }
-
- proc get_bind_type { column } {
- return [[get_bind_entry $column] binding]
- }
-
- proc mss_gen_compare {sect table { selector "" } \
- {pre1 ""} {post1 ""} {pre2 ""} {post2 ""} {seperator ", "} \
- {newline ""} { master_table "" } { dbproc "dbproc"} } {
-
- set columns [ get_col_list $table $selector $master_table]
-
- while {! [lempty $columns] } {
- set col [lvarpop columns]
- set col_nm [$col getUniqueName]
-
- $sect append "dbfcmd($dbproc,\"$pre1$col_nm$post1="
- $sect append "[get_format_char $col]"
- if {! [lempty $columns] } {
- $sect append $seperator
- }
- $sect append "$newline\",$pre2$col_nm$post2);\n"
- }
- }
-
- proc mss_gen_compare_cl {sect link {pre1 ""} {post1 ""} \
- {pre2 ""} {post2 ""} {seperator ", "}
- {newline ""} { dbproc "dbproc" }} {
-
- if { [ $link getLinkType] == "export" } {
- set link [ $link friendLink]
- }
-
- set columns [ $link columnSet ]
-
- while {! [lempty $columns] } {
- set col [lvarpop columns]
- set tcol_nm [$col getUniqueName]
- set mcol_nm [$col getForeignName]
-
- $sect append "dbfcmd($dbproc,\"$pre1$tcol_nm$post1="
- $sect append "[get_format_char $col]"
- if {! [lempty $columns] } {
- $sect append $seperator
- }
- $sect append "$newline\",$pre2$mcol_nm$post2);\n"
- }
- }
-
- proc mss_gen_binding { sect link { pre ""} { post "" } { selector "ALL" } \
- { master_table "" } { dbproc "dbproc"}} {
-
- set columns [ get_col_list $link $selector $master_table]
- set colnum 0
-
- while {! [lempty $columns] } {
- set col [lvarpop columns]
- set colnum [expr $colnum + 1]
- set tcol_nm [$col getUniqueName]
- set type [$col getType3GL]
-
- $sect append "dbbind($dbproc, $colnum, "
- $sect append "[get_bind_type $col], (DBINT) 0, "
- $sect append "(BYTE *) "
-
- # Check if this is a pointer type
- if { ! [regexp {^.+(\[[0-9]+\])|(\*)$} $type] } {
- $sect append "&"
- }
-
- $sect append "${pre}${tcol_nm}${post});\n"
- }
- }
-
- proc mss_gen_nbinding { sect link { pre ""} { post "" } { selector "ALL" } \
- { master_table "" } { dbproc "dbproc"} } {
-
- set columns [ get_col_list $link $selector $master_table]
- set colnum 0
-
- while {! [lempty $columns] } {
- set col [lvarpop columns]
- set colnum [expr $colnum + 1]
- set tcol_nm [$col getUniqueName]
-
- $sect append "dbnullbind($dbproc, $colnum, "
- $sect append "(LPCDBINT) &${pre}${tcol_nm}${post});\n"
- }
- }
-
- proc mss_gen_var_ind_list { sect table { selector "ALL" } \
- { pre1 "" } { pre2 "" } { pre3 "" } { sep ", " } \
- { master_table "" } { dbproc "dbproc" } } {
-
- set columns [ get_col_list $table $selector $master_table]
-
- while {! [lempty $columns] } {
- set col [lvarpop columns]
- set col_nm [$col getUniqueName]
- set type [$col getType3GL]
-
- if {! [lempty $columns] } {
- set csep $sep
- } else {
- set csep ""
- }
-
- $sect append "if (${pre2}$col_nm == -1) \{\n"
- $sect indent +
- $sect append "dbcmd($dbproc,\"${pre3}${col_nm}=NULL${csep}\");\n"
- $sect indent -
- $sect append "\} else \{\n"
- $sect indent +
- $sect append "dbfcmd($dbproc,\"${pre3}${col_nm}="
- $sect append "[get_format_char $col]$csep"
- $sect append "\",${pre1}$col_nm);\n"
- $sect indent -
- $sect append "\}\n"
- }
- }
-
- #
- # Work around for problem with cardinality in the SQL model
- #
- proc mss_sqlpostfix_needed { col } {
- if {[$col getTypeStd] == "serial"} {
- if {[$col get_obj_type] != "imp_column"} {
- return "IDENTITY"
- }
- }
- if {[$col getColumnType] == "key"} {
- return "NOT NULL"
- }
- if [$col isNullable] {
- return "NULL"
- }
- return "NOT NULL"
- }
-