added sysprog entities
This commit is contained in:
408
SYSPROG/STPROC/MEMORY_SERVICES.txt
Normal file
408
SYSPROG/STPROC/MEMORY_SERVICES.txt
Normal file
@ -0,0 +1,408 @@
|
||||
Function Memory_Services(@Service, @Params)
|
||||
/***********************************************************************************************************************
|
||||
|
||||
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
|
||||
permission from SRP Computer Solutions, Inc.
|
||||
|
||||
Name : Memory_Services
|
||||
|
||||
Description : Handler program for all module related services.
|
||||
|
||||
Notes : The generic parameters should contain all the necessary information to process the services. Often
|
||||
this will be information like the data Record and Key ID.
|
||||
|
||||
Parameters :
|
||||
Service [in] -- Name of the service being requested
|
||||
Error [out] -- Any errors that were created
|
||||
Param1-10 [in/out] -- Additional request parameter holders
|
||||
Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
|
||||
|
||||
History : (Date, Initials, Notes)
|
||||
03/29/13 dmb [SRPFW-9] Original programmer.
|
||||
08/01/13 dmb [SRPFW-16] Add PM_CURRENT_IMAGE_PATH as an option to the GETVALUES list.
|
||||
10/01/13 dmb [SRPFW-18] Replace APP_INSERTS with LOGICAL and declare Error_Services. -
|
||||
10/05/13 dmb [SRPFW-18] Add the RemoveKey service.
|
||||
11/06/14 dmb [SRPFW-79] Add support to tag cached data with a time marker in the SetValue service so
|
||||
subsequent GetValue calls can avoid using data that might be too old.
|
||||
10/29/17 dmb Retrofit to use Enhanced BASIC+.
|
||||
02/17/18 dmb Add support to name specific memory service caches. This was to allow some memory service
|
||||
data to be protect from the ReleaseHashTable service. All services will default to the
|
||||
general cache if no cache name is specified. Added ReleaseAllHashTables to clear all caches.
|
||||
09/25/19 dmb [SRPFW-278] Update all services that support named caches so that whenever the named cache
|
||||
doesn't exist it will create one automatically rather than default to the primary cache.
|
||||
|
||||
***********************************************************************************************************************/
|
||||
|
||||
#pragma precomp SRP_PreCompiler
|
||||
|
||||
$insert LOGICAL
|
||||
$insert SERVICE_SETUP
|
||||
|
||||
Common /MemoryServices/ MemoryServicesManagers@, MemoryCacheNames@, Unused3@, Unused4@, Unused5@, Unused6@
|
||||
|
||||
Equ Day$ to 86400 ; // Seconds in one day.
|
||||
|
||||
// Self referencing declarations.
|
||||
Declare function Memory_Services
|
||||
Declare subroutine Memory_Services, Error_Services
|
||||
// SRP FastArray declarations.
|
||||
Declare function SRP_FastArray_Count, SRP_FastArray_Create, SRP_FastArray_Extract, SRP_FastArray_GetVariable,
|
||||
Declare subroutine SRP_FastArray_Delete, SRP_FastArray_Insert, SRP_FastArray_InsertFromList, SRP_FastArray_Release, SRP_FastArray_Replace, SRP_FastArray_ReplaceWithList
|
||||
// SRP HashTable declarations.
|
||||
Declare function SRP_HashTable_Create, SRP_HashTable_Contains, SRP_HashTable_Count, SRP_HashTable_Get, SRP_HashTable_GetKeys, SRP_HashTable_GetValues, SRP_HashTable_GetKeyValuePairs
|
||||
Declare subroutine SRP_HashTable_Set, SRP_HashTable_Release, SRP_HashTable_Remove
|
||||
// SRP List declarations.
|
||||
Declare function SRP_List_Create, SRP_List_CreateFromFastArray, SRP_List_Count, SRP_List_GetAt, SRP_List_GetVariable, SRP_List_Locate
|
||||
Declare subroutine SRP_List_Add, SRP_List_InsertAt, SRP_List_Release, SRP_List_RemoveAt, SRP_List_SetAt
|
||||
// SRP Array declarations.
|
||||
Declare function SRP_Clean_Array, SRP_Join_Arrays, SRP_Reorder_Array, SRP_Rotate_Array, SRP_Sort_Array
|
||||
|
||||
GoToService else
|
||||
Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
|
||||
end
|
||||
|
||||
Return Response OR ''
|
||||
|
||||
|
||||
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
||||
// Service Parameter Options
|
||||
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
||||
Options BOOLEAN = True$, False$
|
||||
|
||||
|
||||
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
||||
// Services
|
||||
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// KeyExists
|
||||
//
|
||||
// Returns a True or False depending on whether the Key ID exists.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service KeyExists(KeyID, CacheName)
|
||||
|
||||
KeyExists = False$ ; // Assume it does not exist for now.
|
||||
|
||||
If Len(KeyID) then
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
// The named cache does not exist so create it now.
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
HandlePos = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
If Len(MemoryServicesManagers@<HandlePos>) then
|
||||
KeyExists = SRP_HashTable_Contains(MemoryServicesManagers@<HandlePos>, KeyID)
|
||||
end
|
||||
end else
|
||||
Error_Services('Set', 'Key ID did not contain a value in the KeyExists service request.')
|
||||
end
|
||||
|
||||
Response = KeyExists
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// GetValue
|
||||
//
|
||||
// Returns the value pair stored in the SRP Hash Table for the current Key ID. If the NotExpired flag is set, the
|
||||
// ExpirationDuration will be used to compare against the last time marker set for the current data.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service GetValue(KeyID, NotExpired, ExpirationDuration, CacheName)
|
||||
|
||||
Value = '' ; // Assume the value is null for now.
|
||||
|
||||
If Len(KeyID) then
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
// The named cache does not exist so create it now.
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
HandlePos = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
If Len(MemoryServicesManagers@<HandlePos>) then
|
||||
If NotExpired then
|
||||
CurrMarker = (Date() * Day$) + Time()
|
||||
PrevMarker = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID)
|
||||
If (CurrMarker - PrevMarker) LT ExpirationDuration then
|
||||
Value = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, KeyID)
|
||||
end
|
||||
end else
|
||||
Value = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, KeyID)
|
||||
end
|
||||
end
|
||||
end else
|
||||
Error_Services('Set', 'Key ID did not contain a value in the GetValue service request.')
|
||||
end
|
||||
|
||||
Response = Value
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// SetValue
|
||||
//
|
||||
// Updates the value pair stored in the SRP Hash Table for the current Key ID.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service SetValue(KeyID, Value, CacheName)
|
||||
|
||||
If Len(KeyID) then
|
||||
// If the Memory Services's hash table does not yet exist then create it now.
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
// The named cache does not exist so create it now.
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
HandlePos = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
If Len(MemoryServicesManagers@<HandlePos>) else
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
end
|
||||
SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, KeyID, Value)
|
||||
// Set a time marker for this data in case future GetValue services need to know how old the data is.
|
||||
TimeMarker = (Date() * Day$) + Time()
|
||||
SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID, TimeMarker)
|
||||
end else
|
||||
Error_Services('Set', 'Key ID did not contain a value in the SetValue service request.')
|
||||
end
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// IsValueExpired
|
||||
//
|
||||
// Returns a Boolean flag indicated whether the current value for the indicated KeyID has expired. This relies upon the
|
||||
// time marker set using the SetValue service. If this value has net yet been set then the value will be considered as
|
||||
// expired.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service IsValueExpired(KeyID, ExpirationDuration, ResetAge, CacheName)
|
||||
|
||||
If Not(Num(ExpirationDuration)) then ExpirationDuration = 0
|
||||
ValueExpired = True$ ; // Assume the value has expired for now.
|
||||
If ResetAge NE True$ then ResetAge = False$ ; // Default is false unless otherwise specified.
|
||||
|
||||
If Len(KeyID) AND (ExpirationDuration GT 0) then
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
// The named cache does not exist so create it now.
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
HandlePos = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
If Len(MemoryServicesManagers@<HandlePos>) then
|
||||
PrevMarker = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID)
|
||||
If PrevMarker NE '' then
|
||||
TimeMarker = (Date() * Day$) + Time()
|
||||
If (TimeMarker - PrevMarker) LE ExpirationDuration then
|
||||
ValueExpired = False$
|
||||
If ResetAge EQ True$ then
|
||||
SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID, TimeMarker)
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end else
|
||||
Error_Services('Set', 'KeyID or ExpirationDuraton was missing in the IsValueExpired service.')
|
||||
end
|
||||
|
||||
Response = ValueExpired
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// IsValueCurrent
|
||||
//
|
||||
// Returns a Boolean flag indicated whether the current value for the indicated KeyID is still current. This relies upon the
|
||||
// time marker set using the SetValue service. If this value has net yet been set then the value will be considered as
|
||||
// expired.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service IsValueCurrent(KeyID, ExpirationDuration, ResetAge, CacheName)
|
||||
|
||||
If Not(Num(ExpirationDuration)) then ExpirationDuration = 0
|
||||
ValueCurrent = False$ ; // Assume the value is not current for now.
|
||||
If ResetAge NE True$ then ResetAge = False$ ; // Default is false unless otherwise specified.
|
||||
|
||||
If Len(KeyID) AND (ExpirationDuration GT 0) then
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
// The named cache does not exist so create it now.
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
HandlePos = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
If Len(MemoryServicesManagers@<HandlePos>) then
|
||||
PrevMarker = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID)
|
||||
If PrevMarker NE '' then
|
||||
TimeMarker = (Date() * Day$) + Time()
|
||||
If (TimeMarker - PrevMarker) LE ExpirationDuration then
|
||||
ValueCurrent = True$
|
||||
If ResetAge EQ True$ then
|
||||
SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID, TimeMarker)
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end else
|
||||
Error_Services('Set', 'KeyID or ExpirationDuraton was missing in the IsValueCurrent service.')
|
||||
end
|
||||
|
||||
Response = ValueCurrent
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// RemoveKey
|
||||
//
|
||||
// Removes the Key ID, and its value pair, from the SRP Hash Table.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service RemoveKey(KeyID, CacheName)
|
||||
|
||||
If Len(KeyID) then
|
||||
// If the Memory Services's hash table does not yet exist then create it now.
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
// The named cache does not exist so create it now.
|
||||
Memory_Services('CreateHashTable', CacheName)
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
|
||||
HandlePos = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
If Len(MemoryServicesManagers@<HandlePos>) then
|
||||
SRP_HashTable_Remove(MemoryServicesManagers@<HandlePos>, KeyID)
|
||||
end
|
||||
end else
|
||||
Error_Services('Set', 'Key ID did not contain a value in the RemoveKey service request.')
|
||||
end
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// CreateHashTable
|
||||
//
|
||||
// Creates the SRP Hash Table that the Memory_Services module will use to manage various Key ID and Value pairs. A
|
||||
// check will first be made to see if the handle to the Hash Table already exists. If so then it will be released and
|
||||
// a new Hash Table will be created.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service CreateHashTable(CacheName)
|
||||
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
If Len(MemoryServicesManagers@<HandlePos>) then
|
||||
Memory_Services('ReleaseHashTable')
|
||||
end
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos then
|
||||
Memory_Services('ReleaseHashTable', CacheName)
|
||||
end else
|
||||
HandlePos = DCount(MemoryCacheNames@, @FM) + 1
|
||||
If HandlePos EQ 1 then HandlePos = 2 ; // Handle position 1 is reserved for the default cache.
|
||||
end
|
||||
end
|
||||
|
||||
MemoryServicesManagers@<HandlePos> = SRP_HashTable_Create()
|
||||
If HandlePos GT 1 then
|
||||
MemoryCacheNames@<HandlePos> = CacheName
|
||||
end
|
||||
|
||||
Response = MemoryServicesManagers@<HandlePos>
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// ReleaseHashTable
|
||||
//
|
||||
// Releases the SRP Hash Table handle. If CacheName is empty then the default handle is released.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service ReleaseHashTable(CacheName)
|
||||
|
||||
HandlePos = ''
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else Null
|
||||
end
|
||||
|
||||
If HandlePos GE 1 then
|
||||
SRP_HashTable_Release(MemoryServicesManagers@<HandlePos>)
|
||||
MemoryServicesManagers@<HandlePos> = ''
|
||||
MemoryCacheNames@<HandlePos> = ''
|
||||
end
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// ReleaseAllHashTables
|
||||
//
|
||||
// Releases all SRP Hash Table handles.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service ReleaseAllHashTables(CacheName)
|
||||
|
||||
If MemoryServicesManagers@ NE '' then
|
||||
For Each Handle in MemoryServicesManagers@ using @FM
|
||||
If Handle NE '' then SRP_HashTable_Release(Handle)
|
||||
Next Handle
|
||||
end
|
||||
MemoryServicesManagers@ = ''
|
||||
MemoryCacheNames@ = ''
|
||||
|
||||
end service
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
// GetHandle
|
||||
//
|
||||
// Returns the handle to the SRP Hash Table used by Memory_Services.
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
Service GetHandle(CacheName)
|
||||
|
||||
HandlePos = ''
|
||||
If CacheName EQ '' then
|
||||
HandlePos = 1
|
||||
end else
|
||||
Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else Null
|
||||
end
|
||||
|
||||
If HandlePos GE 1 then
|
||||
Handle = MemoryServicesManagers@<HandlePos>
|
||||
end
|
||||
|
||||
Response = Handle
|
||||
|
||||
end service
|
||||
|
||||
|
||||
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
||||
// Internal GoSubs
|
||||
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////?
|
||||
|
Reference in New Issue
Block a user