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
		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)
				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

