Files
open-insight/LSL2/STPROC/ARCHIVE_SERVICES.txt
Ouellette Jonathan (CSC FI SPS MESLEO) 05e0fb3eda Merged PR 28607: Archive Services Initial Pull
This is the initial pull for Archiving data.
2025-10-16 23:55:23 +00:00

1607 lines
68 KiB
Plaintext

Compile function Archive_Services(@Service, @Params)
#pragma precomp SRP_PreCompiler
$Insert SERVICE_SETUP
$insert LOGICAL
$insert APP_INSERTS
$Insert WO_LOG_EQUATES
$Insert WO_STEP_EQUATES
$Insert RDS_EQUATES
$Insert REACT_RUN_EQUATES
$Insert RDS_LAYER_EQUATES
$Insert RDS_TEST_EQUATES
$Insert ARCHIVE_EQUATES
$Insert RLIST_EQUATES
$Insert ARCHIVE_QUEUE_EQUATES
$Insert DELETE_QUEUE_EQUATES
$Insert DELETE_QUEUE_ERROR_EQUATES
$Insert ARCHIVE_QUEUE_ERROR_EQUATES
$insert SRPJSONX
EQU COMMA$ To ','
Declare subroutine Change_Log_Services, Logging_Services, Error_Services, Database_Services
Declare subroutine Set_Status, Set_MFS, Btree.Extract, Archive_Services, Delay
Declare function SRP_Datetime, Logging_Services, Environment_Services, Datetime, RTI_CreateGUID
Declare function Database_Services, Wo_Mat_Services, Error_Services, RDS_Services, RTI_OS_Directory
Declare function WM_In_Services, WM_Out_Services, DirExists, Archive_Services, Work_Order_Services
Declare function email_Services, UCase, Date_Services
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive'
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ArchiveService.csv'
Headers = 'Logging DTM' : @FM : 'Message' : @FM : 'Cutoff Date'
objLogArchiveService = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
OPTIONS ARCHIVE_TYPES = 'WO_LOG'
GoToService
Return Response or ""
//-----------------------------------------------------------------------------
// SERVICES
//-----------------------------------------------------------------------------
/*
RunArchive
Step 1.1 of data archiving procedures.
Responsible for initiating the Archive Process by creating ARCHIVE records of a specified type.
No return type.
Parameters-
ArchiveType - Determines what method will be run to generate the ARCHIVE record.
*/
Service RunArchive(ArchiveType=ARCHIVE_TYPES)
hSysLists = Database_Services('GetTableHandle', 'SYSLISTS')
Lock hSysLists, ServiceKeyID then
ErrorMsg = ''
If ArchiveType NE '' then
ArchiveSettings = Database_Services('ReadDataRow', 'APP_INFO', 'ARCHIVE_CONFIG')
Locate ArchiveType in ArchiveSettings<1> using @VM setting ArchConfPos then
YearsBackSetting = ArchiveSettings<2, ArchConfPos>
CreatedArchiveRecId = ''
KeysToArchive = ''
Begin Case
Case ArchiveType EQ 'WO_LOG'
//Get WO_LOG Keys
KeysToArchive = Work_Order_Services('GetClosedWOsToArchive', YearsBackSetting)
if Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
Case Otherwise$
ErrorMsg = 'Invalid archive type.'
End Case
end else
ErrorMsg = 'Archive settings not found in APP_INFO -> ARCHIVE_CONFIG.'
end
If ErrorMsg EQ '' then
ArchiveRecordsIds = ''
If KeysToArchive NE '' then
ArchiveCountLimit = 30000
ArchiveCount = 0
for each Key in KeysToArchive using @VM
Until ArchiveCount EQ ArchiveCountLimit
CreatedArchiveRecId = Archive_Services('CreateArchiveRecord', Key, ArchiveType, False$, True$)
If Error_Services('NoError') then
If CreatedArchiveRecId NE '' then
ArchiveRecordsIds<1, -1> = CreatedArchiveRecId
ArchiveCount += 1
end
end else
ErrorMsg = Error_Services('GetMessage')
end
Next Key
end
Archive_Services('GenerateArchiveCreationReport', ArchiveRecordsIds)
end
end else
ErrorMsg = 'Archive type was null.'
end
If ErrorMsg NE '' then
Error_Services('Add', ErrorMsg)
end
Unlock hSysLists, ServiceKeyID else Null
end
end service
/*
CreateArchiveRecord
Step 1.2 of data archiving procedures.
Responsible for creating an ARCHIVE record for WO_LOG hierarchies.
Returns the key ID for a record created in the ARCHIVE table. The key is a GUID string.
Parameters-
ParentRecordId - The key ID of the parent record.
ArchiveType - The table of the parent record.
*/
Service CreateArchiveRecord(ParentRecordId, ArchiveType, ReArchive, AddToQueue)
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\ArchiveRecordCreation'
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ArchiveCreation.csv'
Headers = 'Logging DTM' : @FM : 'Record Table' : @FM : 'Record Id' : @FM : 'Success' : @FM : 'Message'
objRecordArchival = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$)
ErrorMsg = ''
ArchiveId = ''
ArchiveSeq = 1
If ParentRecordId NE '' then
If ArchiveType NE '' then
if Not(ReArchive) then
ArchiveId = ArchiveType : '*' : ParentRecordId : '*' : ArchiveSeq
end else
ValidId = False$
for ArchiveSeq = 1 to 99
Until ValidId = True$
ArchiveId = ArchiveType : '*' : ParentRecordId : '*' : ArchiveSeq
If Not(RowExists('ARCHIVE', ArchiveId)) then
ValidId = True$
end
Next ArchiveSeq
end
If Not(RowExists('ARCHIVE', ArchiveId)) then
ArchiveRecord = ''
ChildRecords = ''
Begin Case
Case ArchiveType EQ 'WO_LOG'
ChildRecords = Work_Order_Services('GetWOLogHierachy', ParentRecordId)
MetaData = Work_Order_Services('GetWOMetaData', ParentRecordId)
If Error_Services('NoError') then
ChildRecordCount = DCount(ChildRecords, @VM)
If ChildRecordCount LE 0 then
ErrorMsg = '0 child records returned.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
Case Otherwise$
ErrorMsg = 'Unsupported Archive Type.'
End Case
If ErrorMsg EQ '' then
ArchivePath = Environment_Services('GetTextDataBackupRootDir'):ArchiveType:'\':ParentRecordId:'\':ArchiveSeq:'\'
DirectoryCreated = RTI_OS_Directory( 'CREATE', ArchivePath)
If DirectoryCreated then
ArchiveRecord<ARCHIVE_ARCHIVE_CREATION_DTM$> = Datetime()
ArchiveRecord<ARCHIVE_ARCHIVE_PATH$> = ArchivePath
ArchiveRecord<ARCHIVE_METADATA_FIELD$> = MetaData<1>
ArchiveRecord<ARCHIVE_METADATA_TYPE$> = MetaData<2>
ArchiveRecord<ARCHIVE_METADATA_VALUE$> = MetaData<3>
for RecPos = 1 to DCount(ChildRecords<1>, @VM)
ArchiveRecord<ARCHIVE_CHILD_RECORD$, RecPos> = ChildRecords<1, RecPos>
ArchiveRecord<ARCHIVE_CHILD_TABLE$, RecPos> = ChildRecords<2, RecPos>
ArchiveRecord<ARCHIVE_CHILD_RECORD_ARCHIVED$, RecPos> = False$
ArchiveRecord<ARCHIVE_CHILD_RECORD_DELETED$, RecPos> = False$
Next i
Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRecord)
If Error_Services('NoError') then
CreatedArchiveId = ArchiveId
If AddToQueue then
AddedToArchiveQueue = Archive_Services('AddToArchiveQueue', CreatedArchiveId)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Error creating text file backup directory.'
end
end
end else
ErrorMsg = 'Archive record already exists.'
end
end else
ErrorMsg = 'Archive Type was null.'
end
end else
ErrorMsg = 'Record ID was null.'
end
If ErrorMsg EQ '' then
LogData = ''
LogData<1> = LoggingDTM;
LogData<2> = ArchiveType
LogData<3> = ParentRecordId
LogData<4> = True$
LogData<5> = 'Successfully created ARCHIVE record - ' : ArchiveId
Logging_Services('AppendLog', objRecordArchival, LogData, @RM, @FM, False$)
Response = ArchiveId
end else
LogData = ''
LogData<1> = LoggingDTM;
LogData<2> = ArchiveType
LogData<3> = ParentRecordId
LogData<4> = False$
LogData<5> = 'Error creating ARCHIVE record - ' : ErrorMsg
Logging_Services('AppendLog', objRecordArchival, LogData, @RM, @FM, False$)
Error_Services('Add', ErrorMsg)
end
end service
/*
AddToArchiveQueue
Step 1.3 of data archiving procedures.
Responsible for creating record in the ARCHIVE_QUEUE table.
These records relate to an ARCHIVE record.
Returns the GUID key ID of the ARCHIVE_QUEUE record created.
Parameters-
ArchiveId - The key ID of the ARCHIVE record which is being queued for child record archival.
*/
Service AddToArchiveQueue(ArchiveId)
ErrorMsg = ''
AddedToArchiveQueue = False$
If ArchiveId NE '' then
If RowExists('ARCHIVE', ArchiveId) then
ArchiveQueueId = RTI_CreateGUID()
ArchiveQueueRec = ''
ArchiveQueueRec<ARCHIVE_QUEUE_ARCHIVE_ID$> = ArchiveId
Database_Services('WriteDataRow', 'ARCHIVE_QUEUE', ArchiveQueueId, ArchiveQueueRec)
If Error_Services('NoError') then
AddedToArchiveQueue = True$
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive record ' : ArchiveId : ' was not found in ARCHIVE table.'
end
end else
ErrorMsg = 'Archive Id was null'
end
If ErrorMsg NE '' then
Error_Services('Add', 'Error adding archive to archive queue : ' : ErrorMsg)
end
Response = AddedToArchiveQueue
end service
/*
ProcessArchiveQueue
Step 2.1 of data archiving procedures.
Responsible for getting and looping through keys in the ARCHIVE_QUEUE table.
Then processing the record with that key and passing it off to the ArchiveRecords service
If the ArchiveRecords service returns true then deletes the ARCHIVE_QUEUE record.
If the ArchiveRecords service returns false, then tranfers the ARCHIVE_QUEUE record to the
ARCHIVE_QUEUE_ERROR table. Deletes the ARCHIVE_QUEUE record.
Parameters-
None.
*/
Service ProcessArchiveQueue()
ErrorMsg = ''
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordArchiving'
ServiceErrMsg = ''
ServiceLogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ServiceLog.csv'
ServiceHeaders = 'Logging DTM' : @FM : 'Message'
ServiceLogObj = Logging_Services('NewLog', LogPath, ServiceLogFileName, CRLF$, ',', ServiceHeaders, '', False$, False$)
hSysLists = Database_Services('GetTableHandle', 'SYSLISTS')
Lock hSysLists, ServiceKeyID then
open 'ARCHIVE_QUEUE' to FileIn then
SelectStmt = 'SELECT ARCHIVE_QUEUE'
RList(SelectStmt,TARGET_ACTIVELIST$,'','','')
Done = False$
loop
readnext ArchiveQueueId else Done = 1
until Done
ArchiveId = XLATE('ARCHIVE_QUEUE', ArchiveQueueId, ARCHIVE_QUEUE_ARCHIVE_ID$, 'X')
Archive_Services('ArchiveRecords', ArchiveId)
If Error_Services('HasError') then
ProcessError = Error_Services('GetMessage')
Error_Services('Clear')
ArchiveErrQueueRec = ''
ArchiveErrQueueRec<ARCHIVE_QUEUE_ERROR_ARCHIVE_ID$> = ArchiveId
ArchiveErrQueueRec<ARCHIVE_QUEUE_ERROR_ERROR_MSG$> = ProcessError
Database_Services('WriteDataRow', 'ARCHIVE_QUEUE_ERROR', ArchiveQueueId, ArchiveErrQueueRec)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
Database_Services('DeleteDataRow', 'ARCHIVE_QUEUE', ArchiveQueueId, True$, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
Done = True$; // Limits service to run one record at a time.
REPEAT
end else
ErrorMsg = 'Error opening RECORD_ARCHIVE_QUEUE table.'
end
// Service level Logging
if ErrorMsg EQ '' then
ServiceMessage = 'Archive queue service finished without error.'
end else
ServiceMessage = ErrorMsg
end
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogData = ''
LogData<1> = LoggingDTM
LogData<2> = ServiceMessage
Logging_Services('AppendLog', ServiceLogObj, LogData, @RM, @FM, False$)
end
Unlock hSysLists, ServiceKeyID else Null
end service
/*
ArchiveRecords
Step 2.2 of data archiving procedures.
Responsible for looping through an ARCHIVE records CHILD_RECORDS field. Then for each record
pass it to the ArchiveRecordToTxtFile service to be backed up(Or any new methods meant to back up a record).
If all records successfully archive returns a True.
If any records fail then processing of the ARCHIVE record pauses and returns a false.
Parameters -
ArchiveId - The key ID to the ARCHIVE record being processed.
*/
Service ArchiveRecords(ArchiveId)
ErrorMsg = ''
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordArchiving'
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ExecutionLog.csv'
Headers = 'Logging DTM' : @FM : 'Archive Queue ID' : @FM : 'Archive ID' : @FM : 'Message'
objArchiveRecordsLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$)
AllRecordsArchived = False$
If ArchiveId NE '' then
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$)
If Error_Services('NoError') then
ArchiveSavePath = ArchiveRec<ARCHIVE_ARCHIVE_PATH$>
NumRecordsToArchive = DCOUNT(ArchiveRec<ARCHIVE_CHILD_RECORD$>, @VM)
if NumRecordsToArchive GT 0 then
for each Record in ArchiveRec<ARCHIVE_CHILD_RECORD$> using @VM setting RecPos
Until ErrorMsg NE ''
ThisRecord = ArchiveRec<ARCHIVE_CHILD_RECORD$, RecPos>
ThisTable = ArchiveRec<ARCHIVE_CHILD_TABLE$, RecPos>
ThisRecordArchived = ArchiveRec<ARCHIVE_CHILD_RECORD_ARCHIVED$, RecPos>
If Not(ThisRecordArchived) then
RecordArchivedTxt = Archive_Services('ArchiveRecordToTxtFile', ThisTable, ThisRecord, ArchiveSavePath)
if Error_Services('NoError') then
RecordArchivedJson = Archive_Services('ArchiveRecordToJson', ThisRecord, ThisTable, ArchiveSavePath)
If Error_Services('NoError') then
If RecordArchivedTxt AND RecordArchivedJson then
ArchiveRec<ARCHIVE_CHILD_RECORD_ARCHIVED$, RecPos> = True$
Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'One or more archive methods failed.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end
Next Record
If ErrorMsg EQ '' then
Archive_Services('AddToDeleteQueue', ArchiveId)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
end else
ErrorMsg = 'Archive record had zero child records.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive ID was null.'
end
If ErrorMsg EQ '' then
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogData = ''
LogData<1> = LoggingDTM;
LogData<2> = ArchiveId
LogData<3> = 'Successfully archived all records in ARCHIVE.'
Logging_Services('AppendLog', objArchiveRecordsLog, LogData, @RM, @FM, False$)
AllRecordsArchived = True$
end else
ErrorMsg = 'Error in ArchiveRecords service - ' : ErrorMsg
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogData = ''
LogData<1> = LoggingDTM;
LogData<2> = ArchiveId
LogData<3> = ErrorMsg
Logging_Services('AppendLog', objArchiveRecordsLog, LogData, @RM, @FM, False$)
Error_Services('Add', ErrorMsg)
end
Response = AllRecordsArchived
end service
/*
ArchiveRecordToTxtFile
Step 2.3 of data archiving procedures.
One of the possible methods that can used to backup a file.
This service reads a specific record and backs up the data to raw text in a .txt file.
Then verifies content by calling the VerifyTextBackup service.
If VerifyTextBackup service returns false then this service returns false.
If VerifyTextBackup service returns true then this service returns true.
Parameters-
RecordTable - The table of the record being backed up
RecordId - The key id of the record being backed up
SavePath - The location to save the txt file backup.
*/
Service ArchiveRecordToTxtFile(RecordTable, RecordId, SavePath)
ErrorMsg = ''
RecordBackedUp = False$
If RecordTable NE '' then
If RecordId NE '' then
If RowExists(RecordTable, RecordId) then
If SavePath NE '' then
SavePathExists = DirExists(SavePath)
If SavePathExists then
Record = Database_Services('ReadDataRow', RecordTable, RecordId, True$, 0, False$)
If Error_Services('NoError') then
FileName = RecordTable:'-':RecordId:'.txt'
FullSavePath = SavePath : FileName
swap '*' with '%2A' in FullSavePath
Set_Status(0)
OSWrite Record to FullSavePath; // Todo Error checking for write and read
TextBackupVerified = Archive_Services('VerifyTextBackup', RecordTable, RecordId, FullSavePath, True$)
if Error_Services('NoError') then
if TextBackupVerified then
RecordBackedUp = True$
end else
ErrorMsg = 'Error in text file backup verification.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Specified save path was not found.'
end
end else
ErrorMsg = 'Save path was null.'
end
end else
ErrorMsg = 'Specific record {':RecordTable:'} {':RecordId:'} was not found in the specified table.'
end
end else
ErrorMsg = 'Record Id was null.'
end
end else
ErrorMsg = 'Record Table was null.'
end
If ErrorMsg NE '' then
Error_Services('Add', ErrorMsg)
end
Response = RecordBackedUp
end service
Service ArchiveRecordToJson(RecordId, RecordTable, SavePath)
SavedToJson = False$
ErrorMsg = ''
If RecordId NE '' then
If RecordTable NE '' then
If SavePath NE '' then
SavePathExists = DirExists(SavePath)
If SavePathExists then
If RowExists(RecordTable, RecordId) then
FileName = RecordTable:'-':RecordId:'.json'
FullSavePath = SavePath : FileName
swap '*' with '%2A' in FullSavePath
RecordJSonData = Archive_Services('ConvertGenericRecordToJson', RecordId, RecordTable)
If Error_Services('NoError') then
ValidJson = SRP_JsonX_Parse('JsonCheck', RecordJSonData)
If ValidJson then
Set_Status(0)
OSWrite RecordJSonData to FullSavePath
SavedToJson = True$
end else
ErrorMsg = 'No valid json detected.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
Set_Status(0)
OSWrite RecordJSonData to FullSavePath;
If Get_Status(errCode) then
ErrorMsg = 'Error writing archive Json file.'
end
end else
ErrorMsg = RecordId : ' in ' : RecordTable : ' does not exist.'
end
end else
ErrorMsg = 'Specified save path was not found.'
end
end else
ErrorMsg = 'SavePath parameter was null.'
end
end else
ErrorMsg = 'RecordTable parameter was null.'
end
end else
ErrorMsg = 'RecordId parameter was null.'
end
If ErrorMsg EQ '' then
Response = SavedToJson
end else
Error_Services('Add', ErrorMsg)
end
end service
Service ConvertArchiveRecordToJson(ArchiveId)
ErrorMsg = ''
JsonData = ''
If ArchiveId NE '' then
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$)
If Error_Services('NoError') then
SRP_JsonX_Begin('JSON', '{')
SRP_JsonX('ArchiveId', ArchiveId, 'String')
DtmCreated = Date_Services('ConvertDateTimeToISO8601', ArchiveRec<ARCHIVE_ARCHIVE_CREATION_DTM$>)
SRP_JsonX('ArchiveCreationDtm', DtmCreated)
SRP_JsonX('ArchiveFilePath', ArchiveRec<ARCHIVE_ARCHIVE_PATH$>, 'String')
SRP_JsonX('ArchiveCompleted', ArchiveRec<ARCHIVE_COMPLETE$>, 'Bool')
DtmCompleted = Date_Services('ConvertDateTimeToISO8601', ArchiveRec<ARCHIVE_ARCHIVE_COMPLETION_DTM$>)
SRP_JsonX('ArchiveCompletionDtm', DtmCompleted)
SRP_JsonX('ChildRecords', '[')
for each Record in ArchiveRec<ARCHIVE_CHILD_RECORD$> using @VM setting RecPos
SRP_JsonX('{')
SRP_JsonX('RecordTable', ArchiveRec<ARCHIVE_CHILD_TABLE$, RecPos>, 'String')
SRP_JsonX('RecordId', ArchiveRec<ARCHIVE_CHILD_RECORD$, RecPos>, 'String')
SRP_JsonX('RecordArchived', ArchiveRec<ARCHIVE_CHILD_RECORD_ARCHIVED$, RecPos>, 'Bool')
SRP_JsonX('RecordDeleted', ArchiveRec<ARCHIVE_CHILD_RECORD_DELETED$, RecPos>, 'Bool')
SRP_JsonX('}')
Next Record
SRP_JsonX(']')
SRP_JsonX('MetaData', '[')
for each MetaDataField in ArchiveRec<ARCHIVE_METADATA_FIELD$> using @VM setting mdPos
SRP_JsonX('{')
SRP_JsonX('FieldName', ArchiveRec<ARCHIVE_METADATA_FIELD$, mdPos>, 'String')
FieldType = ArchiveRec<ARCHIVE_METADATA_TYPE$, mdPos>
FieldValue = ArchiveRec<ARCHIVE_METADATA_VALUE$, mdPos>
SRP_JsonX('FieldType', FieldType , 'String')
If FieldType EQ 'DateTime' then
FieldValue = OConv(FieldValue, 'DT')
end
SRP_JsonX('FieldValue', FieldValue, 'String')
SRP_JsonX('}')
Next MetaDataField
SRP_JsonX(']')
DtmDeArchived = Date_Services('ConvertDateTimeToISO8601', ArchiveRec<ARCHIVE_DEARCHIVE_DATETIME$>)
SRP_JsonX('DeArchiveDtm', DtmDeArchived, 'String')
JsonData = SRP_JsonX_End('Pretty')
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'ArchiveId parameter was null.'
end
If ErrorMsg EQ '' then
Response = JsonData
end else
Error_Services('Add', ErrorMsg)
end
end service
Service ConvertGenericRecordToJson(RecordId, RecordTable)
ErrorMsg = ''
RecordJson = ''
If RecordId NE '' then
If RecordTable NE '' then
If RowExists(RecordTable, RecordId) then
Record = Database_Services('ReadDataRow', RecordTable, RecordId, True$, 0, False$)
If Error_Services('NoError') then
SRP_JsonX_Begin(RecordTable : '*' : RecordId, '{')
For each Field in Record using @FM setting FieldPos
If Indexc(Field, @VM, 1) then
//Value Marks Present
SRP_JsonX(FieldPos, '[')
For each Value in Field using @VM setting ValuePos
SRP_JsonX('{')
If Indexc(Value, @SVM, 1) then
SRP_JsonX(ValuePos, '[')
for each SubValue in Value using @SVM setting SubValuePos
SRP_JsonX('{')
SRP_JsonX(SubValuePos, Record<FieldPos, ValuePos, SubValuePos>)
SRP_JsonX('}')
Next SubValue
SRP_JsonX(']')
end else
SRP_JsonX(ValuePos, Record<FieldPos, ValuePos>)
end
SRP_JsonX('}')
Next Value
SRP_JsonX(']')
end else
//No Value Marks Present
SRP_JsonX(FieldPos, Record<FieldPos>)
end
Next Field
RecordJson = SRP_JsonX_End('Pretty')
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = RecordId : ' in ' : RecordTable : ' does not exist.'
end
end else
ErrorMsg = 'RecordTable parameter was null.'
end
end else
ErrorMsg = 'RecordId parameter was null.'
end
If ErrorMsg EQ '' then
Response = RecordJson
end else
Error_Services('Add', ErrorMsg)
end
end service
Service ConvertJsonToRecord(JsonData)
ErrorMsg = ''
ConvertedData = ''
If SRP_JsonX_Parse('JsonTest', JsonData) then
NumFields = SRP_JsonX_Count('')
for FieldPos = 1 to NumFields
NumValueMarks = SRP_JsonX_Count(FieldPos)
If NumValueMarks then
// Field has value marks
For ValueMarkPos = 1 to NumValueMarks
NumSubValueMarks = SRP_JsonX_Count(FieldPos : '[':ValueMarkPos:'].':ValueMarkPos)
If NumSubValueMarks GT 1 then
// Value Mark is further delimited with sub-value marks
For SubValueMarkPos = 1 to NumSubValueMarks
ConvertedData<FieldPos, ValueMarkPos, SubValueMarkPos> = SRP_JsonX_Get(FieldPos : '[':ValueMarkPos:'].':ValueMarkPos: '[':SubValueMarkPos:']':'.':SubValueMarkPos)
Next SubValueMarkPos
end else
// Value Mark is not delimited.
ConvertedData<FieldPos, ValueMarkPos> = SRP_JsonX_Get(FieldPos : '[':ValueMarkPos:'].':ValueMarkPos)
end
Next ValueMarkPos
end else
// The field does not have value marks.
FieldData = SRP_JsonX_Get(FieldPos)
ConvertedData<FieldPos> = SRP_JsonX_Get(FieldPos)
end
Next FieldPos
end else
ErrorMsg = 'JsonData passed to routine was invalid.'
end
If ErrorMsg EQ '' then
Response = ConvertedData
end else
Error_Services('Add', ErrorMsg)
end
end service
/*
VerifyTextBackup
Step 2.4 of data archiving procedures.
This service compares the content of a specified txt file and the raw text data of a record in the system.
OR the existence of a text file.
If the data between the two entities matches this service returns a true
If the data between the two entities does not match then this service returns a false.
Parameters-
RecordTable - The table of the record being compared
RecordId - The key id of the record being compares
SavePath - The location of the txt file containing the data.
VerifyFileContents - Optional parameter. If this parameter is false or null then only the existence of a matching text file occurs
If this parameter is true then the content of the text file is compared.
*/
Service VerifyTextBackup(RecordTable, RecordId, PathToTextFile, VerifyFileContents)
ErrorMsg = ''
VerificationPassed = False$
If RecordTable NE '' then
If RecordId NE '' then
If RowExists(RecordTable, RecordId) then
If PathToTextFile NE '' then
FileExists = DirExists(PathToTextFile)
If FileExists EQ 0 OR FileExists EQ 1 then
If VerifyFileContents then
Record = Database_Services('ReadDataRow', RecordTable, RecordId, True$, 0, False$)
If Error_Services('NoError') then
Set_Status(0)
OSRead RecordVerify from PathToTextFile then
If RecordVerify EQ Record then
VerificationPassed = True$
end else
ErrorMsg = 'Record backup verification failed.'
end
end else
ErrorMsg = 'Error verifying record.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
VerificationPassed = True$
end
end else
ErrorMsg = 'Specific path was not found'
end
end else
ErrorMsg = 'Path to text file was null.'
end
end else
ErrorMsg = 'Specific record was not found in the specified table.'
end
end else
ErrorMsg = 'Record Id was null.'
end
end else
ErrorMsg = 'Record Table was null.'
end
If ErrorMsg NE '' then
Error_Services('Add', ErrorMsg)
end
Response = VerificationPassed
end service
/*
AddToDeleteQueue
Step 3.1 of data archiving procedures.
Responsible for creating record in the DELETE_QUEUE table.
These records relate to an ARCHIVE record.
Returns the GUID key ID of the DELETE_QUEUE record created.
Parameters-
ArchiveId - The key ID of the ARCHIVE record which is being queued for child record deletion.
*/
Service AddToDeleteQueue(ArchiveId)
ErrorMsg = ''
AddedToDeleteQueue = False$
If ArchiveId NE '' then
If RowExists('ARCHIVE', ArchiveId) then
ArchiveQueueId = RTI_CreateGUID()
ArchiveQueueRec = ''
ArchiveQueueRec<DELETE_QUEUE_ARCHIVE_ID$> = ArchiveId
Database_Services('WriteDataRow', 'DELETE_QUEUE', ArchiveQueueId, ArchiveQueueRec)
If Error_Services('NoError') then
AddedToDeleteQueue = True$
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive record ' : ArchiveId : ' was not found in ARCHIVE table.'
end
end else
ErrorMsg = 'Archive Id was null'
end
If ErrorMsg NE '' then
Error_Services('Add', 'Error adding archive to deletion queue : ' : ErrorMsg)
end
Response = AddedToDeleteQueue
end service
/*
ProcessDeleteQueue
Step 3.2 of data archiving procedures.
Responsible for getting and looping through keys in the DELETE_QUEUE table.
Then processing the record with that key by passing it off to the DeleteRecords service
If the DeleteRecords service returns true then deletes the DELETE_QUEUE record.
If the DeleteRecords service returns false, then tranfers the DELETE_QUEUE record to the
DELETE_QUEUE_ERROR table. Deletes the DELETE_QUEUE record.
Parameters-
None.
*/
Service ProcessDeleteQueue()
ErrorMsg = ''
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordDeletion'
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ServiceLog.csv'
Headers = 'Logging DTM' : @FM : 'Message'
ServiceLogObj = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$)
hSysLists = Database_Services('GetTableHandle', 'SYSLISTS')
Lock hSysLists, ServiceKeyID then
open 'DELETE_QUEUE' to FileIn then
SelectStmt = 'SELECT DELETE_QUEUE'
RList(SelectStmt,TARGET_ACTIVELIST$,'','','')
Done = 0
loop
readnext DeleteQueueId else Done = 1
until Done
ExecutionErrMsg = ''
ArchiveId = Database_Services('ReadDataColumn', 'DELETE_QUEUE', DeleteQueueIdm, DELETE_QUEUE_ARCHIVE_ID$, True$, 0, False$)
If Error_Services('NoError') then
If ArchiveId NE '' then
If RowExists('ARCHIVE', ArchiveId) then
Archive_Services('DeleteRecords', ArchiveId)
If Error_Services('HasError') then
ProcessError = Error_Services('GetMessage')
Error_Services('Clear')
DeleteErrQueueRec = ''
DeleteErrQueueRec<DELETE_QUEUE_ERROR_ARCHIVE_ID$> = ArchiveId
DeleteErrQueueRec<DELETE_QUEUE_ERROR_ERROR_MSG$> = ProcessError
Database_Services('WriteDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, DeleteErrQueueRec)
If Error_Services('NoError') then
Database_Services('DeleteDataRow', 'DELETE_QUEUE', DeleteQueueId, True$, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
end
Database_Services('DeleteDataRow', 'DELETE_QUEUE', DeleteQueueId, True$, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
end else
ErrorMsg = 'Archive ID within the DELETE Queue record was null.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
Done = True$; //Limits each service call to 1 record to process at a time.
REPEAT
end else
ErrorMsg = 'Error opening Delete Queue table.'
end
// Service level Logging
if ErrorMsg EQ '' then
ServiceMessage = 'Delete queue service finished without error.'
end else
ServiceMessage = ErrorMsg
end
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogData = ''
LogData<1> = LoggingDTM
LogData<2> = ServiceMessage
Logging_Services('AppendLog', ServiceLogObj, LogData, @RM, @FM, False$)
Unlock hSysLists, ServiceKeyID else Null
end
end service
Service RetryDeleteErrorQueue()
ErrorMsg = ''
open 'DELETE_QUEUE_ERROR' to FileIn then
SelectStmt = 'SELECT DELETE_QUEUE_ERROR'
RList(SelectStmt,TARGET_ACTIVELIST$,'','','')
Done = 0
loop
readnext DeleteQueueId else Done = 1
until Done
ExecutionErrMsg = ''
DeleteQueueErrorRec = Database_Services('ReadDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, True$, 0, False$)
if Error_Services('NoError') then
ArchiveId = DeleteQueueErrorRec<DELETE_QUEUE_ARCHIVE_ID$>
If ArchiveId NE '' then
If RowExists('ARCHIVE', ArchiveId) then
Archive_Services('DeleteRecords', ArchiveId)
If Error_Services('NoError') then
Database_Services('DeleteDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, True$, False$)
end else
ProcessError = Error_Services('GetMessage')
DeleteQueueErrorRec<DELETE_QUEUE_ERROR_ERROR_MSG$> = ProcessError
Database_Services('WriteDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, DeleteErrQueueRec, True$, 0, False$)
end
end
end
end
REPEAT
end
end service
/*
DeleteRecords
Step 3.3 of data archiving procedures.
Responsible for looping through an ARCHIVE records CHILD_RECORDS field. Then for each record
pass it to the DeleteRecord service to be deleted from the database.
If all records successfully delete, returns a True.
If any records fail then processing of the DELETE record pauses and returns a false.
Parameters -
ArchiveId - The key ID to the ARCHIVE record being processed.
*/
Service DeleteRecords(ArchiveId)
ErrorMsg = ''
AllRecordsDeleted = False$
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordDeletion'
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ExecutionLog.csv'
Headers = 'Logging DTM' : @FM : 'Archive ID' : @FM : 'Message'
objDeleteRecordsLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$)
If ArchiveId NE '' then
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$)
for RecPos = DCount(ArchiveRec<ARCHIVE_CHILD_RECORD$>, @VM) to 1 step -1
ThisRecord = ArchiveRec<ARCHIVE_CHILD_RECORD$, RecPos>
ThisTable = ArchiveRec<ARCHIVE_CHILD_TABLE$, RecPos>
Archive_Services('VerifyRelationalIndexes', ThisTable, ThisRecord)
Next RecPos
If Error_Services('NoError') then
for RecPos = DCount(ArchiveRec<ARCHIVE_CHILD_RECORD$>, @VM) to 1 step -1
Until ErrorMsg NE ''
ThisRecord = ArchiveRec<ARCHIVE_CHILD_RECORD$, RecPos>
ThisTable = ArchiveRec<ARCHIVE_CHILD_TABLE$, RecPos>
ThisRecordArchived = ArchiveRec<ARCHIVE_CHILD_RECORD_ARCHIVED$, RecPos>
ThisRecordDeleted = ArchiveRec<ARCHIVE_CHILD_RECORD_DELETED$, RecPos>
If ThisRecordArchived then
If Not(ThisRecordDeleted) then
Archive_Services('DeleteRecord', ThisTable, ThisRecord)
If Error_Services('NoError') then
ArchiveRec<ARCHIVE_CHILD_RECORD_DELETED$, RecPos> = True$
Locate 0 in ArchiveRec<ARCHIVE_CHILD_RECORD_DELETED$> using @VM setting DeletedPos else
ArchiveRec<ARCHIVE_COMPLETE$> = True$
ArchiveRec<ARCHIVE_ARCHIVE_COMPLETION_DTM$> = Datetime()
end
Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ArchiveRec<ARCHIVE_CHILD_RECORD_DELETED$, RecPos> = True$
Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
end else
ErrorMsg = 'Record ' : ThisRecord : ' in table ' : ThisTable : ' has not been archived.'
end
Next RecPos
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive ID was null.'
end
If ErrorMsg EQ '' then
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogData = ''
LogData<1> = LoggingDTM;
LogData<2> = ArchiveId
LogData<3> = 'Successfully deleted all records in ARCHIVE.'
Logging_Services('AppendLog', objDeleteRecordsLog, LogData, @RM, @FM, False$)
AllRecordsDeleted = True$
end else
ErrorMsg = 'Error in DeleteRecords service - ' : ErrorMsg
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime
LogData = ''
LogData<1> = LoggingDTM;
LogData<2> = ArchiveId
LogData<3> = ErrorMsg
Logging_Services('AppendLog', objDeleteRecordsLog, LogData, @RM, @FM, False$)
Error_Services('Add', ErrorMsg)
end
Response = AllRecordsDeleted
end service
/*
DeleteRecord
Step 3.4 of data archiving procedures.
Responsible for deleting a record. This method is special because it temporarily removes
all MFS's in order to avoid triggering any MFS logic for the specified record.
Once MFS's are removed, the deletion occurs.
Once the deletion attempt is complete the MFS's are added back to the tables.
If the deletion is successful this service returns a true.
If the deletion fails this service returns a false.
Parameters-
TableName - The table of the record being deleted
RecordId - The key id of the record being deleted
*/
Service DeleteRecord(TableName, RecordId)
ErrorMsg = ''
RecordDeleted = False$
If TableName NE '' then
If RecordId NE '' then
If RowExists(TableName, RecordId) then
TableHandle = Database_Services('GetTableHandle', TableName)
If Error_Services('NoError') then
RetryCount = 3
Done = False$
for i = 1 to RetryCount
Until Done
if i GT 1 then Delay(2)
//Temporarily remove MFS's to skip their execution
OrigMFSList = TableHandle<1, 1>
NumMFS = DCount(OrigMFSList, @SVM)
TempMFSList = OrigMFSList
ReAddMFSList = OrigMFSList
For MFSCnt = NumMFS to 1 Step -1
MFSRoutine = TempMFSList<0, 0, MFSCnt>
// Removal of BASE_MFS allows us to delete records
// Removal of SQL_MFS skips any SQL replication which keeps us from deleting the record there as well.
// Need to remove RTP57 because it auto adds itself and causes an error if you add it manually.
If (MFSRoutine EQ 'BASE_MFS') OR (MFSRoutine EQ 'SQL_MFS*LSL2') OR (MFSRoutine EQ 'RTP57') then
TempMFSList = Delete(TempMFSList, 0, 0, MFSCnt)
if MFSRoutine EQ 'RTP57' then
ReAddMFSList = Delete(ReAddMFSList, 0, 0, MFSCnt)
end
end
Next MFSCnt
Set_MFS(TableName, TempMFSList, 4);// Remove all MFS's
If Not(Get_Status(ErrCode)) then
//Archive_Services('VerifyRelationalIndexes', TableName, RecordId, True$)
//Rewrite the record prior to deletion to resolve any index issues.
RecordPriorToDeletion = Database_Services('ReadDataRow', TableName, RecordId)
If Error_Services('NoError') then
Database_Services('WriteDataRow', TableName, RecordId, RecordPriorToDeletion)
if Error_Services('NoError') then
Database_Services('DeleteDataRow', TableName, RecordId)
If Error_Services('NoError') then
RecordDeleted = Not(RowExists(TableName, RecordId))
If RecordDeleted then
Done = True$
end else
ErrorMsg = TableName : ' - ' : RecordId : ' failed to delete.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = Error_Services('GetMessage')
end
Set_MFS(TableName, ReAddMFSList, 4);// Remove all MFS's;//Put MFS Back onto table
end else
ErrorMsg = 'Error removing MFS from ' : TableName
end
Next i
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
// Do Nothing as this is okay. Record is deleted one way or the other.
end
end else
ErrorMsg = 'RecordID was null.'
end
end else
ErrorMsg = 'TableName was null.'
end
If ErrorMsg EQ '' then
RecordDeleted = True$
end else
RecordDeleted = False$
Error_Services('Add', ErrorMsg)
end
Response = RecordDeleted
end service
Service VerifyRelationalIndexes(TableName, RecordId, SkipMFSRemoval)
ErrorMsg = ''
If ( (TableName NE '') and (RecordId NE '') ) then
TableName = UCase(TableName)
If Not(SkipMFSRemoval) then
GoSub RemoveMFS
end
ServiceModule = TableName:'_SERVICES'
ServiceName = 'VerifyRelationalIndexes'
If RowExists('SYSOBJ', '$':ServiceModule:'*LSL2') then
ServiceModuleContents = Database_Services('ReadDataRow', 'SYSPROCS', ServiceModule:'*LSL2')
If Error_Services('NoError') then
If IndexC(ServiceModuleContents, ServiceName, 1) then
FunctionResponse = Function(@ServiceModule(ServiceName, RecordId))
If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage')
end
end
end
If Not(SkipMFSRemoval) then
GoSub ReAddMFS
end
end
If ErrorMsg NE '' then Error_Services('Add', ErrorMsg)
end service
Service GetAllArchiveIDs()
ErrorMsg = ''
ArchiveIds = ''
open 'ARCHIVE' to FileIn then
SelectStmt = 'SELECT ARCHIVE'
RList(SelectStmt,TARGET_ACTIVELIST$,'','','')
if Not(Get_Status(errCode)) then
Done = 0
loop
readnext ArchiveId else Done = 1
until Done
ArchiveIds<-1> = ArchiveId
Repeat
end else
ErrorMsg = 'Error querying ARCHIVE records.'
end
end else
ErrorMsg = 'Error opening ARCHIVE table.'
end
If ErrorMsg EQ '' then
Response = ArchiveIds
end else
Error_Services('Add', ErrorMsg)
end
end service
/*
FindRecordInArchive
Step 1 of the data de-archive process.
Responsible for locating the ARCHIVE record that contains the key id of an archived child record.
If the record is found the ARCHIVE record ID is returned.
Parameters-
RecordId - The key ID of the record being searched for.
Table - The table the RecordId was contained in prior to being archived.
*/
Service GetArchiveIDsByRecord(RecordId, Table)
ErrorMsg = ''
ArchiveIds = ''
If RecordId NE '' then
If Table NE '' then
Open 'DICT.ARCHIVE' to hArchiveDict then
ArchiveKeys = ''
SearchString = 'CHILD_RECORD':@VM:RecordId:@FM
SearchString := 'CHILD_TABLE':@VM:Table:@FM
Btree.Extract(SearchString, 'ARCHIVE', hArchiveDict, ArchiveKeys, 0, 0)
If Not(Get_Status(errCode)) then
If ArchiveKeys NE '' then
for each ArchiveKey in ArchiveKeys using @VM
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveKey)
if Error_Services('NoError') then
Locate RecordId in ArchiveRec<ARCHIVE_CHILD_RECORD$> using @VM setting RecIdPos then
RecTable = ArchiveRec<ARCHIVE_CHILD_TABLE$, RecIdPos>
If RecTable EQ Table then
ArchiveIds<-1> = ArchiveKey
end
end
end else
ErrorMsg = Error_Services('GetMessage')
end
Next ArchiveKey
end else
ErrorMsg = 'No Archive keys found for matching the parameter combination.'
end
end else
ErrorMsg = 'Error in querying the Archive table.'
end
end else
ErrorMsg = 'Error opening Archive dictionary.'
end
end else
ErrorMsg = 'Table parameter was null.'
end
end else
ErrorMsg = 'RecordId parameter was null.'
end
If ErrorMsg NE '' then
Error_Services('Add', ErrorMsg)
end
Response = ArchiveIds
end service
Service GetArchiveIDsByMetaData(Fields, Values)
ErrorMsg = ''
ArchiveIds = ''
If Fields NE '' then
If Values NE '' then
SearchString = ''
PossibleRecords = ''
Table = 'ARCHIVE'
for each SearchTerm in Values using @VM setting TermPos
SearchString := 'METADATA_FIELD':@VM:Fields<1, TermPos>:@FM
SearchString := 'METADATA_VALUE':@VM:Values<1, TermPos>:@FM
Next SearchTerm
Open 'DICT.ARCHIVE' to hArchiveDict then
Flag = ""
Btree.Extract(SearchString, 'ARCHIVE', hArchiveDict, PossibleRecords, 0, Flag)
if PossibleRecords NE '' then
for each RecordId in PossibleRecords using @VM setting RecIdPos
Until ErrorMsg NE ''
//Need to now verify that the possible found records match the combinations passed in.
FoundComboMatch = False$
ThisArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', RecordId, True$, 0, False$)
MetaDataFields = ThisArchiveRec<ARCHIVE_METADATA_FIELD$>
MetaDataValues = ThisArchiveRec<ARCHIVE_METADATA_VALUE$>
For each SearchTerm in Values using @VM setting FieldPos
Until FoundComboMatch = True$
for each MdValue in MetaDataValues using @VM setting mdPos
Until FoundComboMatch EQ True$
If Fields<1, FieldPos> EQ MetaDataFields<1, mdPos> then
FoundComboMatch = True$
end
Next MdValue
Next Field
If FoundComboMatch True$ then
ArchiveIds<-1> = RecordId
end
Next RecordId
end else
ErrorMsg = 'No matching records found.'
end
end else
ErrorMsg = 'Error opening ARCHIVE dictionary.'
end
end else
ErrorMsg = 'SearchTerm parameter was null.'
end
end else
ErrorMsg = 'Fields parameter was null.'
end
If ErrorMsg EQ '' then
Response = ArchiveIds
end else
Error_Services('Add', ErrorMsg)
end
end service
/*
DeArchiveData
Step 2 of the data de-archive process.
Responsible for reading data back in from a backup to the OpenInsight live system.
Reads an ARCHIVE record to get the file path of the backup then reads the CHILD_RECORD and CHILD_TABLE fields
to find the text files and write them back into the system.
Upon first attempt of de-archive, the de-archive date in the ARCHIVE record is set.
Parameters-
ArchiveId - The whole ARCHIVE record to be de-archived.
*/
Service DeArchiveDataFromTxt(ArchiveId)
ErrorMsg = ''
DeArchiveSuccess = False$
If ArchiveId NE '' then
If RowExists('ARCHIVE', ArchiveId) then
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId)
If Error_Services('NoError') then
//Set the de-archive dtm.
ArchiveRec<ARCHIVE_DEARCHIVE_DATETIME$> = Datetime()
ArchiveFilesPath = ArchiveRec<ARCHIVE_ARCHIVE_PATH$>
for i = DCount(ArchiveRec<ARCHIVE_CHILD_RECORD$>, @VM) to 1 step -1
until ErrorMsg NE ''
RecordExists = False$
RecordId = ArchiveRec<ARCHIVE_CHILD_RECORD$, i>
TableName = ArchiveRec<ARCHIVE_CHILD_TABLE$, i>
RecordDeArchived = ArchiveRec<ARCHIVE_CHILD_RECORD_DE_ARCHIVED$, i>
If Not(RecordDeArchived) then
If Not(RowExists(RecordTable, TableName)) then
TxtFilePath = ArchiveFilesPath
TxtFileName = TableName : '-' : RecordId : '.txt'
swap '*' with '%2A' in TxtFileName
FullSavePath = TxtFilePath : TxtFileName
Record = ''
OSRead Record from FullSavePath then
GoSub RemoveMFS
If ErrorMsg EQ '' then
Database_Services('WriteDataRow', TableName, RecordId, Record)
if Error_Services('NoError') then
If RowExists(TableName, RecordId) then
RecordExists = True$
end else
ErrorMsg = 'An unspecified error occured saving the record.'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
GoSub ReAddMFS
end
end
end else
RecordExists = True$
end
If RecordExists then
ArchiveRec<ARCHIVE_CHILD_RECORD_DE_ARCHIVED$, i> = True$
ArchiveRec<ARCHIVE_CHILD_RECORD_ARCHIVED$, i> = False$
ArchiveRec<ARCHIVE_CHILD_RECORD_DELETED$, i> = False$
end else
ErrorMsg = 'An unspecified error occured saving the record.'
end
end
Next i
Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive record was not found.'
end
end else
ErrorMsg = 'ArchiveId was null.'
end
If ErrorMsg EQ '' then
Response = True$
end else
Response = False$
Error_Services('Add', ErrorMsg)
end
end service
Service DeArchiveDataFromJson(ArchiveId)
ErrorMsg = ''
DeArchiveSuccess = False$
If ArchiveId NE '' then
If RowExists('ARCHIVE', ArchiveId) then
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId)
ArchiveRec<ARCHIVE_DEARCHIVE_DATETIME$> = Datetime()
If Error_Services('NoError') then
ArchiveFilesPath = ArchiveRec<ARCHIVE_ARCHIVE_PATH$>
for i = DCount(ArchiveRec<ARCHIVE_CHILD_RECORD$>, @VM) to 1 step -1
RecordId = ArchiveRec<ARCHIVE_CHILD_RECORD$, i>
TableName = ArchiveRec<ARCHIVE_CHILD_TABLE$, i>
If Not(RowExists(RecordTable, TableName)) then
JsonFilePath = ArchiveFilesPath
JsonFileName = TableName : '-' : RecordId : '.json'
swap '*' with '%2A' in JsonFileName
FullSavePath = JsonFilePath : JsonFileName
Record = ''
OSRead Json from FullSavePath then
//ParseJson
GoSub RemoveMFS
If ErrorMsg EQ '' then
Database_Services('WriteDataRow', TableName, RecordId, Record)
if Error_Services('NoError') then
DeArchiveSuccess = True$
end else
ErrorMsg = Error_Services('GetMessage')
end
GoSub ReAddMFS
end
end
end
Next i
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive record was not found.'
end
end else
ErrorMsg = 'ArchiveId was null.'
end
Response = DeArchiveSuccess
end service
Service ReArchive(ArchiveId)
ErrorMsg = ''
NewArchiveId = ''
If RowExists('ARCHIVE', ArchiveId) then
OrigArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$)
If Error_Services('NoError') then
ArchiveType = Field(ArchiveId, '*', 1)
ArchiveParent = Field(ArchiveId, '*', 2)
If ArchiveType NE '' AND ArchiveParent NE '' then
NewArchiveId = Archive_Services('CreateArchiveRecord', ArchiveParent, ArchiveType, True$, True$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
end
end
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Archive record did not exist.'
end
If ErrorMsg NE '' then
Error_Services('Add', ErrorMsg)
end
Reponse = NewArchiveId
end service
Service GenerateArchiveCreationReport(ArchiveIds)
ErrorMsg = ''
ArchiveData = ''
If ArchiveIds NE '' then
For each ArchiveId in ArchiveIds using @VM setting aPos
ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$)
if Error_Services('NoError') then
ArchiveData<aPos, 1> = Field(ArchiveId, '*', 1);// Table Name
ArchiveData<aPos, 2> = Field(ArchiveId, '*', 2);// Parent Record Id
ArchiveData<aPos, 3> = DCount(ArchiveRec<ARCHIVE_CHILD_RECORD$>, @VM)
end else
ErrorMsg = Error_Services('GetMessage')
end
Next ArchiveId
end else
ArchiveData = 'No records found to Archive.'
end
if ArchiveData NE '' then
MessageDate = OConv(DateTime(), 'DT')
eMailBody = 'Archive Initialization Report'
eMailBody<-1> = 'The following parents records have been detected as ready to archive on ' : MessageDate : '. All records have been queued to for archive.'
eMailBody<-1> = ''
eMailBody<-1> = ArchiveData
swap @VM with ', ' in eMailBody
swap @FM with CRLF$ in eMailBody
emailHeader = 'Archive Report for ' : MessageDate
SentFrom = 'oinotify@infineon.com'
SendTo = 'jonathan.ouellette@infineon.com'
Success = Email_Services('SendEmail', SentFrom, SendTo, eMailHeader, eMailBody)
end else
MessageDate = OConv(DateTime(), 'DT')
eMailBody = 'Archive Initialization Report'
eMailBody<-1> = 'Archive service ran on ' : MessageDate : '. No records were detected.'
swap @FM with CRLF$ in eMailBody
emailHeader = 'Archive Report for ' : MessageDate
SentFrom = 'oinotify@infineon.com'
SendTo = 'jonathan.ouellette@infineon.com'
Success = Email_Services('SendEmail', SentFrom, SendTo, eMailHeader, eMailBody)
end
end service
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Internal GoSubs
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
RemoveMFS:
TableHandle = Database_Services('GetTableHandle', TableName)
If Error_Services('NoError') then
//Temporarily remove MFS's to skip their execution
OrigMFSList = TableHandle<1, 1>
NumMFS = DCount(OrigMFSList, @SVM)
TempMFSList = OrigMFSList
ReAddMFSList = OrigMFSList
For MFSCnt = NumMFS to 1 Step -1
MFSRoutine = TempMFSList<0, 0, MFSCnt>
// Removal of BASE_MFS allows us to delete records
// Removal of SQL_MFS skips any SQL replication which keeps us from deleting the record there as well.
// Need to remove RTP57 because it auto adds itself and causes an error if you add it manually.
If (MFSRoutine EQ 'BASE_MFS') OR (MFSRoutine EQ 'SQL_MFS*LSL2') OR (MFSRoutine EQ 'RTP57') then
TempMFSList = Delete(TempMFSList, 0, 0, MFSCnt)
if MFSRoutine EQ 'RTP57' then
ReAddMFSList = Delete(ReAddMFSList, 0, 0, MFSCnt)
end
end
Next MFSCnt
Set_MFS(TableName, TempMFSList, 4);// Remove all MFS's
If Get_Status(ErrCode) then
ErrorMsg = 'Error Setting MFS'
end
end else
ErrorMsg = Error_Services('GetMessage')
end
return
ReAddMFS:
Set_MFS(TableName, ReAddMFSList, 4);// Remove all MFS's;//Put MFS Back onto table
return
ClearCursors:
For counter = 0 to 8
ClearSelect counter
Next counter
return