343 lines
12 KiB
Plaintext
343 lines
12 KiB
Plaintext
Compile subroutine Create_Table_In_SQL(Table, GenerateCodeOnly)
|
|
|
|
/*****************************************************************************\
|
|
This is a utility function. Using the table's dictionary, it creates a
|
|
basic matching table in the SQL database, omitting explicit multivalue and
|
|
symbolic fields. Simply makes work a little faster.
|
|
|
|
PARAMETERS:
|
|
Table - The table for which code and sql tables are to be
|
|
created.
|
|
GenerateCodeOnly - Set to 1 to generate code and not sql tables. Set to 2
|
|
to generate delete code only and not sql tables.
|
|
|
|
History
|
|
-------
|
|
04/12/2010 KRF Original Programmer
|
|
04/22/2010 KRF Added logic to rename DESC to DESCRIPTION to avoid SQL
|
|
errors
|
|
07/12/2010 KRF Updated to handle multiple primary keys
|
|
09/08/2010 KRF Swapped FIELDCOUNT with field count + 1 to make sure
|
|
records with undocumented extra fields do not cause
|
|
the SQL statements to fail.
|
|
09/21/2010 KRF Added support for generating DELETE subroutine
|
|
\*****************************************************************************/
|
|
|
|
$insert Microsoft_Ado_Equates
|
|
|
|
If Assigned(Table) else Table = ""
|
|
If Assigned(GenerateCodeOnly) else GenerateCodeOnly = 0
|
|
|
|
Declare subroutine SRP_Com, Rlist, Repository, SRP_Editor_Open
|
|
Declare function SRP_Com, Max, Repository
|
|
Ans = ""
|
|
|
|
// Make sure table is uppercase
|
|
Convert @LOWER_CASE to @UPPER_CASE in Table
|
|
|
|
// Get the list of reserved keywords
|
|
ReservedWords = Xlate("SYSENV", "SQL_RESERVED_WORDS", "", "X")
|
|
|
|
// The expected name of the handler
|
|
Handler = "COPY_":Table:"_RECORD_TO_SQL"
|
|
|
|
Open "DICT.":Table to hDict then
|
|
|
|
// Connect to the ODBC
|
|
If SRP_Com(Connection, "CREATE", "ADODB.Connection") then
|
|
|
|
// Connect to the database via ODBC
|
|
SRP_Com(Connection, "SET", "Mode", adModeShareDenyNone)
|
|
SRP_Com(Connection, "SET", "CursorLocation", adUseClient)
|
|
If SRP_Com(Connection, "CALL", "Open", "LSL2SQL", "srpadmin", "0okm9ijn") EQ "" then
|
|
|
|
// Get single-valued fields in order of position
|
|
ClearSelect
|
|
Rlist("SELECT DICT.":Table:" BY COLUMN_POS BY F5 WITH COLUMN_TYPE = 'F' AND WITH F4 = 'S'", 5, "", "", "")
|
|
|
|
// As we create the script, build a simple list of keys and data fields, used to generate code
|
|
KeyList = ""
|
|
FieldList = ""
|
|
|
|
// While we're at it, get the lengths of the longest key and field, which will help in formatting the generated code
|
|
MaxKeyLen = 0
|
|
NumKeys = 0
|
|
MaxFieldLen = 0
|
|
MaxFieldPos = 0
|
|
|
|
// Delimite the table if necessary
|
|
Locate Table in ReservedWords using @FM setting Pos then
|
|
TableName = Table:"_TABLE"
|
|
end else
|
|
TableName = Table
|
|
end
|
|
|
|
// Create script
|
|
Script = "CREATE TABLE ":TableName:" ("
|
|
Done = 0
|
|
Loop
|
|
ReadNext Key else Done = 1
|
|
Until Done
|
|
|
|
// Escape reserved words
|
|
Locate Key in ReservedWords using @FM setting Pos then
|
|
KeyName = "[":Key:"]"
|
|
end else
|
|
KeyName = Key
|
|
end
|
|
|
|
// The column name and type
|
|
Read Rec from hDict, Key then
|
|
Script := KeyName:" "
|
|
GoSub AddType
|
|
end
|
|
|
|
// The Not Null field
|
|
If Rec<31> EQ "1" then
|
|
Script := " NOT NULL"
|
|
end
|
|
|
|
// Set as primary key if necessary
|
|
If Rec<2> EQ "0" then
|
|
* Script := " PRIMARY KEY"
|
|
KeyList := KeyName:@VM:FormatCode:@VM:FormatAux:@FM
|
|
MaxKeyLen = Max(MaxKeyLen, Len(KeyName))
|
|
NumKeys += 1
|
|
end else
|
|
FieldList := KeyName:@VM:FormatCode:@VM:FormatAux:@VM:Rec<2>:@FM
|
|
MaxFieldLen = Max(MaxFieldLen, Len(KeyName))
|
|
MaxFieldPos = Max(MaxFieldPos, Rec<2>)
|
|
end
|
|
|
|
// Assume another field following
|
|
Script := ", "
|
|
|
|
Repeat
|
|
|
|
// Add primary keys
|
|
If NumKeys GT 0 then
|
|
Script := " CONSTRAINT pk_":TableName:" PRIMARY KEY ("
|
|
For iKey = 1 to NumKeys
|
|
KeyName = KeyList<iKey, 1>
|
|
If iKey GT 1 then
|
|
Script := ", ":KeyName
|
|
end else
|
|
Script := KeyName
|
|
end
|
|
Next iKey
|
|
Script := ")"
|
|
end else
|
|
// Remove the last comma and close the script
|
|
Script[-2, 2] = ""
|
|
end
|
|
|
|
Script := ")"
|
|
* debug
|
|
// Remove trailing @FMs in the key and field lists
|
|
KeyList[-1, 1] = ""
|
|
FieldList[-1, 1] = ""
|
|
|
|
// Run the script and/or generate the code
|
|
If GenerateCodeOnly then
|
|
GoSub Generate_Code
|
|
end else
|
|
Result = SRP_Com(Connection, "CALL", "Execute", Script)
|
|
If Result NE 0 then
|
|
SRP_Com(Result, "RELEASE")
|
|
GoSub Generate_Code
|
|
end else
|
|
Call Msg(@Window, "Error creating table ":TableName:"||Script = ":Quote(Script):"||":SRP_Com(Connection, "ERROR"))
|
|
end
|
|
end
|
|
|
|
end else
|
|
Ans = SRP_Com(Connection, "ERROR")
|
|
end
|
|
|
|
SRP_Com(Connection, "CALL", "Close")
|
|
SRP_Com(Connection, "RELEASE")
|
|
end
|
|
|
|
end
|
|
|
|
Return Ans
|
|
|
|
AddType:
|
|
|
|
SqlType = "varchar(50)"
|
|
FormatCode = "STR"
|
|
FormatAux = ""
|
|
ColumnType = Rec<12>
|
|
ColumnTypeName = ColumnType[1, '(']
|
|
Begin Case
|
|
Case ColumnTypeName _EQC "BOOLEAN"
|
|
SqlType = "bit"
|
|
FormatCode = "BIT"
|
|
Case ColumnType _EQC "CHAR"
|
|
SqlType = "char(1)"
|
|
Case ColumnTypeName _EQC "DATE"
|
|
SqlType = "datetime"
|
|
FormatCode = "DATE"
|
|
Case ColumnTypeName _EQC "DATETIME"
|
|
SqlType = "datetime"
|
|
FormatCode = "DATETIME"
|
|
Case ColumnTypeName _EQC "DECIMAL"
|
|
Format = Rec<7>
|
|
DecPlaces = 6
|
|
If Format[1, 2] EQ "MD" then
|
|
DecPlaces = Format[3, 1]
|
|
end
|
|
SqlType = "decimal(15, ":DecPlaces:")"
|
|
FormatCode = "DEC"
|
|
FormatAux = DecPlaces
|
|
Case ColumnTypeName _EQC "DOLLARS"
|
|
SqlType = "money"
|
|
Case ColumnTypeName _EQC "FLOAT"
|
|
SqlType = "float"
|
|
Case ColumnTypeName _EQC "INTEGER"
|
|
SqlType = "int"
|
|
FormatCode = "INT"
|
|
Case ColumnTypeName _EQC "TEXT"
|
|
SqlType = "text"
|
|
Case ColumnTypeName _EQC "TIME"
|
|
SqlType = "datetime"
|
|
FormatCode = "TIME"
|
|
Case ColumnTypeName _EQC "VARBINARY"
|
|
SqlType = "varbinary(50)"
|
|
End Case
|
|
Script := SqlType
|
|
|
|
return
|
|
|
|
Generate_Code:
|
|
|
|
// Determine whether to use the normal template or the one that supports MV fields
|
|
ClearSelect
|
|
RList("SELECT 1 DICT.":Table:" WITH F4 = 'M'", 5, "", "", "")
|
|
ReadNext Key then
|
|
TemplateName = "TEMPLATE_COPY_RECORD_TO_SQL_MV"
|
|
DeleteTemplateName = "TEMPLATE_DELETE_RECORD_FROM_SQL_MV"
|
|
end else
|
|
TemplateName = "TEMPLATE_COPY_RECORD_TO_SQL"
|
|
DeleteTemplateName = "TEMPLATE_DELETE_RECORD_FROM_SQL"
|
|
end
|
|
|
|
// Load the template
|
|
Template = Xlate("SYSENV", TemplateName, "", "X")
|
|
DeleteTemplate = Xlate("SYSENV", DeleteTemplateName, "", "X")
|
|
Insert = ""
|
|
Keys = ""
|
|
DataFields = ""
|
|
|
|
// Determine if there is an insert
|
|
If Xlate("SYSPROCS", Table:"_EQUATES*LSL2", "", "X") NE "" then
|
|
Insert = "$insert ":Table:"_EQUATES":\0D0A0D0A\
|
|
end else
|
|
If Xlate("SYSPROCS", Table:"_EQU*LSL2", "", "X") NE "" then
|
|
Insert = "$insert ":Table:"_EQU":\0D0A0D0A\
|
|
end
|
|
end
|
|
|
|
// Build Keys
|
|
KeyListCount = Count(KeyList, @FM) + (KeyList NE "")
|
|
If KeyListCount GT 0 then
|
|
If KeyListCount EQ 1 then
|
|
Name = KeyList<1, 1>
|
|
Format = KeyList<1, 2>
|
|
Aux = KeyList<1, 3>
|
|
Keys := 'Keys = "':Name:'":@VM:SQL_Format(Key, "':Format
|
|
If Aux NE "" then
|
|
Keys := '", "':Aux
|
|
end
|
|
Keys := '")'
|
|
end else
|
|
For iKeyList = 1 to KeyListCount
|
|
Name = KeyList<iKeyList, 1>
|
|
Format = KeyList<iKeyList, 2>
|
|
Aux = KeyList<iKeyList, 3>
|
|
Keys := 'Keys '
|
|
If iKeyList = 1 then
|
|
Keys := ' ='
|
|
end else
|
|
Keys := ':='
|
|
end
|
|
Keys := ' "':Name:'"':Str(" ", MaxKeyLen - Len(Name)):':@VM:SQL_Format(Field(Key, "*", ':iKeyList:'), "':Format
|
|
If Aux NE "" then
|
|
Keys := '", "':Aux
|
|
end
|
|
If iKeyList EQ KeyListCount then
|
|
Keys := '")'
|
|
end else
|
|
Keys := '"):@FM':\0D0A\
|
|
end
|
|
Next iKeyList
|
|
end
|
|
end
|
|
|
|
// Build Fields
|
|
FieldListCount = Count(FieldList, @FM) + (FieldList NE "")
|
|
If FieldListCount GE 1 then
|
|
For iFieldList = 1 to FieldListCount
|
|
Name = FieldList<iFieldList, 1>
|
|
Format = FieldList<iFieldList, 2>
|
|
Aux = FieldList<iFieldList, 3>
|
|
Pos = FieldList<iFieldList, 4>
|
|
DataFields := 'DataFields '
|
|
If iFieldList = 1 then
|
|
DataFields := ' ='
|
|
end else
|
|
DataFields := ':='
|
|
end
|
|
DataFields := ' "':Name:'"':Str(" ", MaxFieldLen - Len(Name)):':@VM:SQL_Format(Rec('
|
|
If Insert EQ "" then
|
|
DataFields := Pos:'), ':Str(" ", Len(MaxFieldPos) - Len(Pos))
|
|
end else
|
|
DataFields := Table:'_':Name:'$), ':Str(" ", MaxFieldLen - Len(Name))
|
|
end
|
|
DataFields := '"':Format
|
|
If Aux NE "" then
|
|
DataFields := '", "':Aux
|
|
end
|
|
If iFieldList EQ FieldListCount then
|
|
DataFields := '")'
|
|
end else
|
|
DataFields := '"):@FM':\0D0A\
|
|
end
|
|
Next iKeyList
|
|
end
|
|
|
|
// Swaps for COPY template
|
|
Swap "%TABLE%" with Table in Template
|
|
Swap "%TABLE_NAME%" with TableName in Template
|
|
Swap "%INSERT%" with Insert in Template
|
|
Swap "%FIELDCOUNT%" with (MaxFieldPos + 1) in Template
|
|
Swap "%DATE%" with OConv(Date(), "D4/") in Template
|
|
Swap "%KEYS%" with Keys in Template
|
|
Swap "%DATAFIELDS%" with DataFields in Template
|
|
|
|
// Swaps for DELETE template
|
|
Swap "%TABLE%" with Table in DeleteTemplate
|
|
Swap "%TABLE_NAME%" with TableName in DeleteTemplate
|
|
Swap "%DATE%" with OConv(Date(), "D4/") in DeleteTemplate
|
|
Swap "%KEYS%" with Keys in DeleteTemplate
|
|
|
|
// Create and open COPY template
|
|
EntName = "COPY_":Table:"_RECORD_TO_SQL"
|
|
EntId = "LSL2*STPROC**":EntName
|
|
Source = Repository("ACCESS", EntId)
|
|
If Get_Status(StatusCode) then
|
|
Repository("NEW", EntId, "", 1, 1, "", "", "", "", "", EntName, Template)
|
|
end
|
|
SRP_Editor_Open("Procedure", EntId)
|
|
|
|
// Create and open DELETE template
|
|
EntName = "DELETE_":Table:"_RECORD_FROM_SQL"
|
|
EntId = "LSL2*STPROC**":EntName
|
|
Source = Repository("ACCESS", EntId)
|
|
If Get_Status(StatusCode) then
|
|
Repository("NEW", EntId, "", 1, 1, "", "", "", "", "", EntName, DeleteTemplate)
|
|
end
|
|
SRP_Editor_Open("Procedure", EntId)
|
|
|
|
return
|