Function Service_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 : Service_Services Description : Handler program for all module related services. Notes : Service module to support environmental state issues. Environmental refers to the state of the operating system, which includes version, client vs. server, and path to critical systems. Parameters : Service [in] -- Name of the service being requested Param1-10 [in/out] -- Additional request parameter holders Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure Metadata : History : (Date, Initials, Notes) 02/06/18 dmb Original programmer. 07/25/18 dmb Update the GetServices service to pick services without any assigned servers. This is to allow a service to be ran against any server. ***********************************************************************************************************************/ #pragma precomp SRP_PreCompiler $Insert APP_INSERTS $Insert SERVICE_SETUP $Insert SERVICES_EQUATES $Insert RLIST_EQUATES $Insert SQL_REQUESTS_EQUATES $Insert PROC_QUEUE_EQUATES $Insert PROC_QUEUE_FAILED_EQUATES Equ Comma$ to ',' Common /ServiceServices/ Unused1@, Unused2@, Unused3@, Unused4@, Unused5@, Unused6@, Unused7@, Unused8@, Unused9@, Unused10@ Declare function Service_Services, Memory_Services, SRP_List, SRP_FastArray, SRP_Array, Database_Services, Datetime Declare function GetTickCount, SRP_Decode, RTI_CreateGuid, UCase, Environment_services, Logging_Services Declare subroutine Service_Services, Memory_Services, SRP_List, SRP_FastArray, RList, Set_Status, Database_Services Declare Subroutine Yield, WinYield, Sleepery, Btree.Extract, Logging_Services, obj_Notes LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\ProcQueue' LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Procedure Queue Log.csv' Headers = 'Logging DTM' : @FM : 'Machine' : @FM : 'RequestKeyId' : @FM : 'Procedure' : @FM : 'Params' : @FM : 'Result' : @FM : 'Error Message' objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$) LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM GoToService else Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' services module.') end Return Response OR '' //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Service Parameter Options //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// Options BOOLEAN = True$, False$ //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Services //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //---------------------------------------------------------------------------------------------------------------------- // GetServices // // Returns an array of active services for the indicated server. //---------------------------------------------------------------------------------------------------------------------- Service GetServices(Server) Services = '' If Server NE '' then Sentence = 'SELECT SERVICES WITH SERVER EQ ' : Quote(Server) : ' AND WITH ACTIVE EQ "Yes"' rv = Set_Status(0) RList(Sentence, TARGET_ACTIVELIST$, '', '', '') If (@List_Active EQ 3) AND (@RecCount GT 0) then EOF = False$ Loop Readnext ServiceKeyID else EOF = True$ Until EOF EQ True$ ServiceRow = Database_Services('ReadDataRow', 'SERVICES', ServiceKeyID) If Error_Services('NoError') then Services := ServiceKeyID : @VM : ServiceRow : @VM : ServiceRow : @FM end Repeat end Sentence = 'SELECT SERVICES WITH SERVER EQ "" AND WITH ACTIVE EQ "Yes"' rv = Set_Status(0) RList(Sentence, TARGET_ACTIVELIST$, '', '', '') If (@List_Active EQ 3) AND (@RecCount GT 0) then EOF = False$ Loop Readnext ServiceKeyID else EOF = True$ Until EOF EQ True$ ServiceRow = Database_Services('ReadDataRow', 'SERVICES', ServiceKeyID) If Error_Services('NoError') then Services := ServiceKeyID : @VM : ServiceRow : @VM : ServiceRow : @FM end Repeat end Services[-1, 1] = '' end else Error_Services('Add', 'Server argument was missing from the ' : Service : ' service.') end Response = Services end service //---------------------------------------------------------------------------------------------------------------------- // GetServices // // Returns an array of active services for the indicated server. //---------------------------------------------------------------------------------------------------------------------- Service GetServiceKeys() Services = '' Sentence = 'SELECT SERVICES BY NAME' rv = Set_Status(0) RList(Sentence, TARGET_ACTIVELIST$, '', '', '') If (@List_Active EQ 3) AND (@RecCount GT 0) then EOF = False$ Loop Readnext ServiceKeyID else EOF = True$ Until EOF EQ True$ Services := ServiceKeyID : @FM Repeat end Services[-1, 1] = '' Response = Services end service //---------------------------------------------------------------------------------------------------------------------- // GetService // // Returns the details of the indicated service. //---------------------------------------------------------------------------------------------------------------------- Service GetService(Service) ServiceDetails = '' If Service NE '' then ServiceDetails = Database_Services('ReadDataRow', 'SERVICES', Service) end else Error_Services('Add', 'Service argument was missing from the ' : Service : ' service.') end Response = ServiceDetails end service Service ProcessProcedureQueue() // Loop through the procedure queue until we can find a process request that is not yet locked // (i.e., already being crunched on by another engine). Process that one request and then end. Open 'PROC_QUEUE' to hProcQueue then Select hProcQueue EOF = False$ Done = False$ Loop ReadNext RequestKeyID else EOF = True$ Until EOF or Done Lock hProcQueue, RequestKeyID then DeleteRequest = True$ Server = Environment_Services('GetServer') Done = True$ Database_Services('GetKeyIDLock', 'PROC_QUEUE', RequestKeyId) RequestRow = Database_Services('ReadDataRow', 'PROC_QUEUE', RequestKeyID) If RequestRow NE '' then Procedure = RequestRow Procedure = UCase(Procedure) Params = RequestRow If Procedure NE '' then Dim ProcParams(12) For each Param in Params using @VM setting pPos ProcParams(pPos) = Param Next Param NumArguments = DCount(Params, @VM) Begin Case Case NumArguments EQ 0 ; Call @Procedure() Case NumArguments EQ 1 ; Call @Procedure(ProcParams(1)) Case NumArguments EQ 2 ; Call @Procedure(ProcParams(1), ProcParams(2)) Case NumArguments EQ 3 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3)) Case NumArguments EQ 4 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4)) Case NumArguments EQ 5 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5)) Case NumArguments EQ 6 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6)) Case NumArguments EQ 7 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7)) Case NumArguments EQ 8 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8)) Case NumArguments EQ 9 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8), ProcParams(9)) Case NumArguments EQ 10 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8), ProcParams(9), ProcParams(10)) Case NumArguments EQ 11 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8), ProcParams(9), ProcParams(10), ProcParams(11)) Case Otherwise$ Error_Services('Add', 'Error in ':Service:' service. More than 11 arguments are not currently supported.') End Case end Swap @VM with ',' in Params LogData = LoggingDTM LogData<2> = Server LogData<3> = RequestKeyId LogData<4> = Procedure LogData<5> = Params ErrCode = '' If ( Get_Status(ErrCode) or Error_Services('HasError') ) then NumAttempts = RequestRow + 1 ErrorMessage = Error_Services('GetMessage') If NumAttempts LT 3 then DeleteRequest = False$ RequestRow = NumAttempts RequestRow = Datetime() RequestRow = 'Error_Services error message: ':ErrorMessage:' Get_Status error code: ':ErrCode Database_Services('WriteDataRow', 'PROC_QUEUE', RequestKeyId, RequestRow, True$, False$, False$) end else // Notify OI_SYSADMIN group Recipients = '' SentFrom = 'SYSTEM' Subject = 'Background Procedure Queue Error' Message = OConv(Datetime(), 'DT2/^H') Message<2> = 'Error on server ':Server Message<3> = 'Stored Procedure: ':Procedure StatCodes = 'Parameters: ':Params Message<4> = 'Error_Services error message: ':ErrorMessage Message<5> = 'Get_Status error code: ':ErrCode Swap @FM with \0D0A\ in Message AttachWindow = '' AttachKey = '' SendToGroup = 'OI_SYSADMIN' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) // Move request to PROC_QUEUE_FAILED RequestRow = NumAttempts RequestRow = Datetime() RequestRow = 'Error_Services error message: ':ErrorMessage:'Get_Status error code: ':ErrCode Database_Services('WriteDataRow', 'PROC_QUEUE_FAILED', RequestKeyId, RequestRow, True$, False$, False$) end LogData<6> = 'Failed' LogData<7> = 'Error_Services error message: ':ErrorMessage:' Get_Status error code: ':ErrCode end else LogData<6> = 'Success' end Logging_Services('AppendLog', objLog, LogData, @RM, @FM) end If DeleteRequest then Database_Services('DeleteDataRow', 'PROC_QUEUE', RequestKeyId, True$, False$) end Unlock hProcQueue, RequestKeyID else Null end Repeat end end service Service PostProcedure(ProcedureName, Params, Critical=BOOLEAN) If Critical EQ '' then Critical = True$ PostToQueue = True$ If (ProcedureName NE '') then If Not(Critical) then // Check if there is already a matching request in the queue before posting another one. Query = 'PROC_NAME':@VM:ProcedureName:@FM Query := 'PARAMS':@VM:Params:@FM Open 'DICT.PROC_QUEUE' to hDict then Keys = '' Option = 'E' Flag = '' Btree.Extract(Query, 'PROC_QUEUE', hDict, Keys, Option, Flag) If Flag EQ 0 then If Keys NE '' then PostToQueue = False$ end else Error_Services('Add', 'Error in ':Service:' service. Error calling Btree.Extract.') end end else Error_Services('Add', 'Error in ':Service:' service. Error opening DICT.PROC_QUEUE.') end end If PostToQueue then RequestKeyID = RTI_CreateGUID() RequestRow = '' RequestRow = ProcedureName RequestRow = Params RequestRow = Datetime() Database_Services('WriteDataRow', 'PROC_QUEUE', RequestKeyID, RequestRow, True$, False$, False$) end end else Error_Services('Add', 'Error in ':Service:' service. Null ProcedureName passed in.') end return Service CleanFailedProcQueue(DaysToRetain) hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\ProcQueue' LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' CleanFailedProcQueue Log.csv' Headers = 'Logging DTM' : @FM : 'Machine' : @FM : 'RequestKeyId' : @FM : 'Procedure' : @FM : 'Params' Headers := @FM : 'Result' : @FM : 'Error Message' objFailedProcQueueLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$) LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM Server = Environment_Services('GetServer') LogData = '' LogData<1> = LoggingDtm LogData<2> = Server LogData<6> = 'Begin CleanFailedProcQueue' Logging_Services('AppendLog', objFailedProcQueueLog, LogData, @RM, @FM) ErrorMsg = '' If (DaysToRetain NE '') then If Num(DaysToRetain) then Open 'PROC_QUEUE_FAILED' to hTable then Cutoff = Datetime() - DaysToRetain Select hTable EOF = False$ Loop Readnext Key else EOF = True$ Until EOF Read Rec from hTable, Key then EntryDtm = Rec If (EntryDtm LT Cutoff) then Delete hTable, Key then LogData<1> = LoggingDtm LogData<2> = Server LogData<3> = Key LogData<4> = Rec ProcFailedParams = Rec Convert @VM to '|' in ProcFailedParams LogData<5> = ProcFailedParams LogData<6> = 'Removed PROC_QUEUE_FAILED record.' LogData<7> = Rec Logging_Services('AppendLog', objFailedProcQueueLog, LogData, @RM, @FM) end else ErrorMsg = 'Error in ':Service:' service. Error deleting PROC_QUEUE_FAILED record ':Key:'.' end end else LogData<1> = LoggingDtm LogData<2> = Server LogData<3> = Key LogData<4> = Rec ProcFailedParams = Rec Convert @VM to '|' in ProcFailedParams LogData<5> = ProcFailedParams LogData<6> = 'Retaining PROC_QUEUE_FAILED record.' LogData<7> = Rec Logging_Services('AppendLog', objFailedProcQueueLog, LogData, @RM, @FM) end end else ErrorMsg = 'Error in ':Service:' service. Error reading PROC_QUEUE_FAILED record ':Key:'.' end Repeat end else ErrorMsg = 'Error in ':Service:' service. Error opening PROC_QUEUE_FAILED table.' end end else ErrorMsg = 'Error in ':Service:' service. DaysToRetain must be a number.' end end else ErrorMsg = 'Error in ':Service:' service. Null DaysToRetain value passed in.' end If ErrorMsg NE '' then LogData<1> = LoggingDtm LogData<2> = Server LogData<6> = ErrorMsg Logging_Services('AppendLog', objFailedProcQueueLog, LogData, @RM, @FM) end LogData<1> = LoggingDtm LogData<2> = Server LogData<6> = 'End CleanFailedProcQueue' Logging_Services('AppendLog', objFailedProcQueueLog, LogData, @RM, @FM) Unlock hSysLists, ServiceKeyID else Null end end service //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// /// Internal GoSubs ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////