added LSL2 stored procedures
This commit is contained in:
342
LSL2/STPROC/CREATE_TABLE_IN_SQL.txt
Normal file
342
LSL2/STPROC/CREATE_TABLE_IN_SQL.txt
Normal file
@ -0,0 +1,342 @@
|
||||
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
|
Reference in New Issue
Block a user