395 lines
9.9 KiB
Plaintext
395 lines
9.9 KiB
Plaintext
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
|
|
|
|
|
|
|
|
|