open-insight/LSL2/STPROC/SQL_WRITE.txt
2024-10-07 21:53:20 +02:00

260 lines
9.0 KiB
Plaintext

Compile function SQL_Write(Connection, TableName, Keys, DataFields)
/*****************************************************************************\
Writes a set of field-value pairs to the SQL connection.
History
-------
04/05/2010 KRF Original Programmer
09/24/2010 KRF Added special check for special case where insert fails
because record already exists
\*****************************************************************************/
$insert Microsoft_Ado_Equates
If Assigned(Connection) else Connection = 0
If Assigned(TableName) else TableName = ""
If Assigned(Keys) else Keys = ""
If Assigned(DataFields) else DataFields = ""
Declare subroutine SRP_Com
Declare function SRP_Com, SRP_Rotate_Array
Ans = ""
// Rebuild the data field array omitting ones with blank values
NumDataFields = Count(DataFields, @FM) + (DataFields NE "")
DataFieldsSource = DataFields
DataFields = ""
For iDataField = 1 to NumDataFields
DataField = DataFieldsSource<iDataField>
If DataField<1, 2> NE "" then
DataFields<-1> = DataField
end
Next iDataField
// Create the where clause expression from the array of keys
KeyExpression = Keys
Swap @VM with " = " in KeyExpression
Swap @FM with " AND " in KeyExpression
// See if the record already exists
Script = "Select Count(*) From ":TableName:" where ":KeyExpression
AttemptsBeforeFailure = 5
Attempts = 0
ErrorMessage = ''
RecordExists = 0
Loop
Attempts += 1
RecordSetResult = SRP_Com(Connection, "CALL", "Execute", Script)
If SRP_COM('', 'ERROR') then
ErrorMessage = 'Query failed to execute'
end else
RecordExists = SRP_Com(RecordSetResult, "CALL", "GetString", 2, 1, @FM, @RM)[1, @RM]
end
Until ( (ErrorMessage EQ '') or (Attempts GT AttemptsBeforeFailure) )
Repeat
SRP_Com(RecordSetResult, "RELEASE")
Script = ""
If RecordExists then
Operation = "Update"
GoSub Do_Update
GoSub Run_Script
end else
Operation = "Insert"
GoSub Do_Insert
GoSub Run_Script
// SPECIAL CASE: Insert might fail if record didn't exist before SQL_WRITE started but
// existed by the time the Insert was executed.
If Ans NE "" then
If IndexC(Ans, "Cannot insert duplicate key in object", 1) then
Operation = "Update After Failed Insert"
// Clear Ans because the failed insert was a false positive.
Ans = ''
GoSub Do_Update
GoSub Run_Script
end
end
end
Return Ans
Run_Script:
// Run the script
If Script then
RecordSetResult = SRP_Com(Connection, "CALL", "Execute", Script)
If RecordSetResult NE 0 then
SRP_Com(RecordSetResult, "RELEASE")
end else
DataOutput = ""
Pos = 1
Loop
DataField = DataFields[Pos, @FM]
Pos = Col2() + 1
Until DataField EQ ""
DataFieldName = DataField[1, @VM]
DataFieldData = DataField[Col2() + 1, @FM]
LenDataFieldData = Len(DataFieldData)
Swap \0D0A\ with @TM in DataFieldData
DataOutput := DataFieldName:", ":DataFieldData:", Len=":LenDataFieldData:@SVM
Repeat
DataOutput[-1, 1] = ""
Swap \0D0A\ with @TM in Script
Ans = "Error writing to ":TableName:" where ":KeyExpression:@VM:Operation:@VM:SRP_Com(Connection, "ERROR"):@VM:Script:@VM:DataOutput
end
end
return
Do_Update:
If DataFields NE "" then
// Initialize the list of names and values
NameList = ""
ValueList = ""
// Separate the array of keys into parallel lists of key names and key values
If Keys NE "" then
KeyArray = SRP_Rotate_Array(Keys)
NameList = KeyArray<1>
ValueList = KeyArray<2>
end
// Separate the array of data fields into parallel lists of fields names and values
If DataFields NE "" AND ValueList NE "" then
DataFieldsRotated = SRP_Rotate_Array(DataFields)
If NameList EQ "" then
NameList = DataFieldsRotated<1>
end else
NameList := @VM:DataFieldsRotated<1>
end
If ValueList EQ "" then
ValueList = DataFieldsRotated<2>
end else
ValueList := @VM:DataFieldsRotated<2>
end
end
// Convert the multivalue lists into comma delimited ones
Swap @VM with ", " in NameList
// Convert dates and times so they match what we'd get from SQL
NewValueList = ""
LenValueList = Len(ValueList)
Pos = 1
Loop
CurrValue = ValueList[Pos, @VM]
Pos = Col2() + 1
If CurrValue[1, 1] EQ "'" AND CurrValue[-1, 1] EQ "'" then
CurrValue[1, 1] = ""
CurrValue[-1, 1] = ""
If (Count(CurrValue, "-") EQ 2 OR Count(CurrValue, ":") EQ 3) AND Count(CurrValue, ".") EQ 0 AND Num(CurrValue[1, 4]) AND Num(CurrValue[5, 2]) AND Num(CurrValue[8, 2]) then
Invalue = IConv(CurrValue[6, 5]:"-":CurrValue[1, 4]:CurrValue[11, 99], "DT")
If Len(Invalue) then
CurrValue = OConv(Invalue, "DT4/^HS")
CurrValue[-2, 0] = " "
CurrValue[12, 2] = Int(CurrValue[12, 2])
CurrValue[4, 2] = Int(CurrValue[4, 2])
CurrValue[1, 2] = Int(CurrValue[1, 2])
end else
Invalue = IConv(CurrValue[6, 5]:"-":CurrValue[1, 4], "D")
If Len(Invalue) then
CurrValue = Int(CurrValue[6, 2]):"/":Int(CurrValue[9, 2]):"/":CurrValue[1, 4]
end else
Invalue = IConv(CurrValue, "MT")
If Len(Invalue) then
CurrValue = OConv(Invalue, "MTHS")
CurrValue = "1/1/1900 ":Int(CurrValue[1, 2]):CurrValue[3, Len(CurrValue) - 4]:" ":CurrValue[-2, 2]
end
end
end
end
end
NewValueList := CurrValue:@FM
Until Pos GE LenValueList
Repeat
NewValueList[-1, 1] = ""
// See if the record already exists
Script = "Select ":NameList:" From ":TableName:" where ":KeyExpression
RecordSetResult = SRP_Com(Connection, "CALL", "Execute", Script)
Record = SRP_Com(RecordSetResult, "CALL", "GetString", 2, 1, @FM, @RM)[1, @RM]
SRP_Com(RecordSetResult, "RELEASE")
Script = ""
If RecordExists NE "" then
// Remove "empty" dates
Swap @FM:"1/1/1900":@FM with @FM:@FM in Record
If Record[-8, 8] EQ "1/1/1900" then Record[-8, 8] = ""
// Only do the update if there's a difference
If NewValueList NE Record then
// Convert the array of data fields into a list of assignments
DataFieldsScript = DataFields
Swap @VM with " = " in DataFieldsScript
Swap @FM with ", " in DataFieldsScript
Script = "Update ":TableName:" Set ":DataFieldsScript:" where ":KeyExpression
end else
Script = ""
end
end
end
return
Do_Insert:
// Since an INSERT statement lists names separate from value, rotate the arrays
// of keys and data fields so that it's easier to extract them separately
// Initialize the list of names and values
NameList = ""
ValueList = ""
// Separate the array of keys into parallel lists of key names and key values
If Keys NE "" then
KeyArray = SRP_Rotate_Array(Keys)
NameList = KeyArray<1>
ValueList = KeyArray<2>
end
// Separate the array of data fields into parallel lists of fields names and values
If DataFields NE "" AND ValueList NE "" then
DataFieldsRotated = SRP_Rotate_Array(DataFields)
If NameList EQ "" then
NameList = DataFieldsRotated<1>
end else
NameList := @VM:DataFieldsRotated<1>
end
If ValueList EQ "" then
ValueList = DataFieldsRotated<2>
end else
ValueList := @VM:DataFieldsRotated<2>
end
end
// Convert the multivalue lists into comma delimited ones
Swap @VM with ", " in NameList
Swap @VM with ", " in ValueList
// Continue only if the lists are not empty
If NameList NE "" AND ValueList NE "" then
Script = "Insert into ":TableName:" (":NameList:") values (":ValueList:")"
end
return