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, obj_Notes DECLARE FUNCTION Set_Status, Database_Services, Logging_Services, Environment_Services, RetStack, obj_Notes DECLARE FUNCTION Error_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 LockReleased = Database_Services('ReleaseKeyIDLock', TableName, TableKey) If Not(LockReleased) then UnlockError = Error_Services('GetMessage') // Logging DTM' : @FM : 'User' : @FM : 'Method' : @FM : 'TableName' : @FM : 'TableKey' : @FM : 'Notes' LogData = '' LogData<1> = LoggingDtm LogData<2> = @User4 LogData<3> = Method LogData<4> = TableName LogData<5> = TableKey LogData<6> = UnlockError LogData<7> = 'Record self locked: ':Database_Services('IsKeyIDSelfLocked', TableName, TableKey) LogData<9> = 'Call stack: ':RetStack() Logging_Services('AppendLog', objLog, LogData, @RM, @FM) Recipients = '' SendFrom = 'System' Subject = 'obj_Tables("WriteRec") failed to release lock' AttachWindow = TableName AttachKey = TableKey SendToGroup = 'FI_SUPPORT' MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:UnlockError:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',MessageParms) end end 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