added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
394
LSL2/STPROC/OBJ_TABLES.txt
Normal file
394
LSL2/STPROC/OBJ_TABLES.txt
Normal file
@ -0,0 +1,394 @@
|
||||
COMPILE FUNCTION obj_Tables(Method,Parms)
|
||||
|
||||
/*
|
||||
Data Table Read, Write, Delete Lock, Unlock Methods
|
||||
|
||||
11/22/00 by JCH - J.C. Henry, Inc
|
||||
|
||||
Properties:
|
||||
|
||||
TableKey Record Key
|
||||
TableRec Record
|
||||
TableName Table Name
|
||||
TableVar Table Variable from OPEN statement (Optional)
|
||||
|
||||
Methods:
|
||||
|
||||
OpenTable(TableName) Open TableName and Return TableVar
|
||||
ReadOnlyRec(TableName,TableKey,TableVar) Read Record Returns TableRecord without Lock
|
||||
ReadRec(TableName,TableKey,TableVar) Read Record for update (with lock set)
|
||||
WriteRec(TableName,TableKey,TableVar,TableRec,Locked) Write Record
|
||||
DeleteRec(TableName,TableKey,TableVar) Delete Record
|
||||
LockRec(TableName,TableKey,TableVar) Lock Record
|
||||
UnlockRec(TableName,TableKey,TableVar) Unlock Record
|
||||
LockSet(TableName,TableKey(s)) Locks all Keys in list
|
||||
UnlockSet(TableName,TableKey(s),TableVar) Unlocks all Keys in list
|
||||
|
||||
|
||||
Records are checked for any contents prior to write. If there is no data in the
|
||||
record then the record is DELETED from the table.
|
||||
|
||||
History:
|
||||
|
||||
08/27/20 DJS Updated UnlockRec subroutine to utilize Database_Services and to only unlock a record
|
||||
if the record is locked in order to avoid setting an FS411 error uneccessarily.
|
||||
|
||||
|
||||
*/
|
||||
|
||||
DECLARE SUBROUTINE Set_Status, Set_FSError, Database_Services, Logging_Services
|
||||
DECLARE FUNCTION Set_Status, Database_Services, Logging_Services, Environment_Services
|
||||
|
||||
EQU Tab$ TO \09\
|
||||
EQU CRLF$ TO \0D0A\
|
||||
EQU LF$ TO \0A\
|
||||
EQU Comma$ TO ','
|
||||
|
||||
EQU TRUE$ TO 1
|
||||
EQU FALSE$ TO 0
|
||||
|
||||
EQU TABLE_NAME$ TO 1
|
||||
EQU TABLE_KEY$ TO 2
|
||||
EQU TABLE_VAR$ TO 3
|
||||
EQU TABLE_REC$ TO 4
|
||||
|
||||
$INSERT CopyRight
|
||||
$INSERT Msg_Equates
|
||||
|
||||
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\obj_Tables'
|
||||
LogDate = Oconv(Date(), 'D4/')
|
||||
LogTime = Oconv(Time(), 'MTS')
|
||||
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' obj_Tables Log.csv'
|
||||
Headers = 'Logging DTM' : @FM : 'User' : @FM : 'Method' : @FM : 'TableName' : @FM : 'TableKey' : @FM : 'Notes'
|
||||
objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
|
||||
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
|
||||
|
||||
ErrTitle = 'Error in obj_Tables'
|
||||
|
||||
ErrorMsg = ''
|
||||
|
||||
IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine.'
|
||||
IF NOT(ASSIGNED(Parms)) THEN ErrorMsg = 'Unassigned parameter "Parms" passed to subroutine.'
|
||||
|
||||
IF Method = '' THEN ErrorMsg = 'Null parameter "Method" passed to subroutine'
|
||||
IF Parms = '' THEN ErrorMsg = 'Null parameter "Parms" passed to subroutine.'
|
||||
|
||||
|
||||
IF ErrorMsg NE '' THEN
|
||||
stat = Set_Status(-1,ErrTitle:@SVM:ErrorMsg) ;* Initialization Errors
|
||||
RETURN ''
|
||||
END
|
||||
|
||||
Result = ''
|
||||
|
||||
TableName = Parms[1,@RM]
|
||||
TableKey = Parms[COL2()+1,@RM]
|
||||
TableVar = Parms[COL2()+1,@RM]
|
||||
TableRec = Parms[COL2()+1,@RM]
|
||||
|
||||
|
||||
BEGIN CASE
|
||||
CASE Method = 'OpenTable' ; GOSUB OpenTable
|
||||
CASE Method = 'ReadOnlyRec' ; GOSUB ReadOnlyRec
|
||||
CASE Method = 'ReadRec' ; GOSUB ReadRec
|
||||
CASE Method = 'WriteRec' ; GOSUB WriteRec
|
||||
CASE Method = 'WriteOnlyRec' ; GOSUB WriteOnlyRec
|
||||
CASE Method = 'DeleteRec' ; GOSUB DeleteRec
|
||||
CASE Method = 'LockRec' ; GOSUB LockRec
|
||||
CASE Method = 'UnlockRec' ; GOSUB UnlockRec
|
||||
CASE Method = 'LockSet' ; GOSUB LockSet
|
||||
CASE Method = 'UnlockSet' ; GOSUB UnlockSet
|
||||
CASE 1
|
||||
ErrorMsg = 'Method ':QUOTE(Method):' not defined in object.'
|
||||
|
||||
END CASE
|
||||
|
||||
|
||||
IF ErrorMsg = '' THEN
|
||||
Parms = FieldStore(Parms,@RM,TABLE_VAR$,0,TableVar)
|
||||
END ELSE
|
||||
stat = Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
||||
RETURN ''
|
||||
END
|
||||
|
||||
RETURN Result
|
||||
|
||||
|
||||
* * * * * * *
|
||||
OpenTable:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
|
||||
IF ErrorMsg = '' THEN
|
||||
OPEN TableName TO TableVar THEN
|
||||
Result = TableVar
|
||||
Parms = FieldStore(Parms,@RM,3,1,TableVar) ;* Added 1/22/2007 JCH
|
||||
END ELSE
|
||||
ErrorMsg = 'Unable to open Table ':QUOTE(TableName)
|
||||
END
|
||||
END
|
||||
|
||||
|
||||
RETURN
|
||||
|
||||
* * * * * * *
|
||||
ReadRec:
|
||||
* * * * * * *
|
||||
|
||||
GOSUB LockRec
|
||||
|
||||
IF ErrorMsg NE '' THEN RETURN
|
||||
|
||||
* * * * * * *
|
||||
ReadOnlyRec:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN
|
||||
GOSUB OpenTable
|
||||
IF ErrorMsg THEN RETURN
|
||||
END
|
||||
|
||||
READ TableRec FROM TableVar,TableKey THEN
|
||||
Result = TableRec
|
||||
END ELSE
|
||||
// Log failure to read
|
||||
LogData = ''
|
||||
LogData<1> = LoggingDTM
|
||||
LogData<2> = @User4
|
||||
LogData<3> = Method
|
||||
LogData<4> = TableName
|
||||
LogData<5> = TableKey
|
||||
LogData<6> = 'Error code: ':@FILE_ERROR<1>:' Error message: ':@FILE_ERROR<2>:' Error detail: ':@FILE_ERROR<3>
|
||||
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
|
||||
|
||||
IF @FILE_ERROR<1> = 100 THEN
|
||||
* Record doesn't exist
|
||||
* 04/20/2021 - DJS - Moved unlock call outside of this specific error condition so that the record is always
|
||||
* unlocked if the record fails to be read.
|
||||
* GOSUB UnlockRec
|
||||
Null
|
||||
END ELSE
|
||||
Set_FSError()
|
||||
ErrorMsg = 'Record ':QUOTE(TableKey):' not found in Table ':QUOTE(TableName)
|
||||
END
|
||||
Result = ''
|
||||
|
||||
If ( (TableName NE '') and (TableKey NE '') ) then
|
||||
RecordLocked = Database_Services('IsKeyIDLocked', TableName, TableKey, False$)
|
||||
If RecordLocked EQ True$ then Database_Services('ReleaseKeyIDLock', TableName, TableKey)
|
||||
end
|
||||
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
WriteRec:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN GOSUB OpenTable
|
||||
|
||||
IF ErrorMsg THEN RETURN
|
||||
|
||||
IF ErrorMsg = '' THEN
|
||||
|
||||
TestRec = TableRec
|
||||
|
||||
CONVERT @SVM:@VM:@FM TO '' IN TestRec
|
||||
|
||||
IF TestRec = '' THEN
|
||||
DELETE TableVar,TableKey ELSE Null
|
||||
* ErrorMsg = 'Blank table rec with ':QUOTE(TableKey):' on ':QUOTE(TableName):' table.'; *added 4/9/21 for debugging
|
||||
* Set_FSError()
|
||||
END ELSE
|
||||
Set_Status(0)
|
||||
rv = Get_Status(errCode)
|
||||
WRITE TableRec ON TableVar,TableKey THEN
|
||||
rv = Get_Status(errCode)
|
||||
END ELSE
|
||||
ErrorMsg = 'Unable to write ':QUOTE(TableKey):' on ':QUOTE(TableName):' table.'
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
If ( (TableName NE '') and (TableKey NE '') ) then
|
||||
RecordLocked = Database_Services('IsKeyIDLocked', TableName, TableKey, False$)
|
||||
If RecordLocked EQ True$ then Database_Services('ReleaseKeyIDLock', TableName, TableKey)
|
||||
end
|
||||
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
WriteOnlyRec:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN GOSUB OpenTable
|
||||
|
||||
IF ErrorMsg THEN RETURN
|
||||
|
||||
IF ErrorMsg = '' THEN
|
||||
|
||||
TestRec = TableRec
|
||||
|
||||
CONVERT @SVM:@VM:@FM TO '' IN TestRec
|
||||
|
||||
IF TestRec = '' THEN
|
||||
DELETE TableVar,TableKey ELSE Null
|
||||
END ELSE
|
||||
WRITE TableRec ON TableVar,TableKey ELSE
|
||||
ErrorMsg = 'Unable to write ':QUOTE(TableKey):' on ':QUOTE(TableName):' table.'
|
||||
END
|
||||
END
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
DeleteRec:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN GOSUB OpenTable
|
||||
|
||||
IF ErrorMsg THEN RETURN
|
||||
|
||||
IF ErrorMsg = '' THEN
|
||||
DELETE TableVar,TableKey THEN
|
||||
GOSUB UnlockRec
|
||||
END
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
* * * * * * *
|
||||
LockRec:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN GOSUB OpenTable
|
||||
|
||||
IF ErrorMsg THEN RETURN
|
||||
|
||||
LockData = ''
|
||||
Locked = FALSE$
|
||||
RetryCnt = 0
|
||||
|
||||
LOOP
|
||||
|
||||
LOCK TableVar,TableKey THEN
|
||||
Locked = TRUE$
|
||||
END ELSE
|
||||
|
||||
BEGIN CASE
|
||||
CASE @FILE_ERROR NE ''
|
||||
Set_FSError()
|
||||
ErrorMsg = 'Unable to Lock ':QUOTE(TableKey):' in Table ':QUOTE(TableName)
|
||||
|
||||
CASE Get_Status(errCode)
|
||||
ErrorMsg = QUOTE(TableKey):' in Table ':QUOTE(TableName):' Locked by another workstation.'
|
||||
|
||||
CASE 1
|
||||
ErrorMsg = QUOTE(TableKey):' in Table ':QUOTE(TableName):' Locked by This workstation.'
|
||||
|
||||
END CASE
|
||||
|
||||
RetryCnt += 1
|
||||
END
|
||||
|
||||
UNTIL Locked OR RetryCnt = 10 REPEAT
|
||||
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
UnlockRec:
|
||||
* * * * * * *
|
||||
|
||||
RecordLocked = Database_Services('IsKeyIDLocked', TableName, TableKey, False$)
|
||||
If RecordLocked EQ True$ then Database_Services('ReleaseKeyIDLock', TableName, TableKey)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
LockSet:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN GOSUB OpenTable
|
||||
|
||||
TableKeys = TableKey ;* Pass in @VM'd list of keys In TableKey
|
||||
|
||||
IF ErrorMsg THEN RETURN
|
||||
|
||||
IF TableKeys = '' THEN RETURN
|
||||
|
||||
Set_Status(0)
|
||||
|
||||
LockedTableKeys = ''
|
||||
|
||||
FOR I = 1 TO COUNT(TableKeys,@VM) + (TableKeys NE '')
|
||||
TableKey = TableKeys<1,I>
|
||||
GOSUB LockRec
|
||||
|
||||
If Locked THEN
|
||||
LockedTableKeys<1,-1> = TableKey
|
||||
End ELSE
|
||||
For N = 1 To Count(LockedTableKeys,@VM) + (LockedTableKeys NE '')
|
||||
TableKey = LockedTableKeys<1,N>
|
||||
Gosub UnlockRec
|
||||
Next N
|
||||
End
|
||||
|
||||
NEXT I
|
||||
|
||||
Result = TableVar
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
UnlockSet:
|
||||
* * * * * * *
|
||||
|
||||
IF TableName = '' THEN ErrorMsg = 'Null parameter "TableName" passed to subroutine'
|
||||
IF TableKey = '' THEN ErrorMsg = 'Null parameter "TableKey" passed to subroutine'
|
||||
IF TableVar = '' THEN ErrorMsg = 'Null parameter "TableVar" passed to subroutine'
|
||||
|
||||
LockedTableKeys = TableKey ;* Pass in @VM'd list of keys In TableKey
|
||||
|
||||
IF ErrorMsg THEN RETURN
|
||||
|
||||
IF LockedTableKeys = '' THEN RETURN
|
||||
|
||||
Set_Status(0)
|
||||
|
||||
|
||||
FOR I = 1 TO COUNT(LockedTableKeys,@VM) + (LockedTableKeys NE '')
|
||||
TableKey = LockedTableKeys<1,I>
|
||||
GOSUB UnlockRec
|
||||
NEXT I
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user