Question
Paul Riker · Apr 24, 2018

Custom Purge Job

I want to create an interface specific purge job. Please let me know if there are any holes in my approach. I realize that an interface that went from HospitalAService to HospitalARouter to PracticeBOperation would require two separate executes in my example below, but I want that granularity as there are some intermediate steps in our workflows that we don't need to retain messages for.

  1. Create a custom scheduled task that extends Ens.MessageHeader
  2. Overwrite the Purge function select statements
    1. Integrity
      1. Old
        • DECLARE C1 CURSOR FOR
           Select TOP 100000000 ID,MessageBodyId,MessageBodyClassName Into :%tID,:%tBodyId,:%tBodyClassname From Ens.MessageHeader h
           Where (TimeCreated < :%tDoNotDeleteDate)
                          And 0 = ( Select Count(*) From Ens.MessageHeader
                                                  Where (SessionId = h.SessionId)
                                                  And (Status<>$$$eMessageStatusCompleted)
                                                 And (Status<>$$$eMessageStatusAborted)
                                                 And (Status<>$$$eMessageStatusError)
                                                 And (Status<>$$$eMessageStatusDiscarded)
                          Order By TimeCreated
                                                                      )
      2. New
        • DECLARE C1 CURSOR FOR
           Select TOP 100000000 ID,MessageBodyId,MessageBodyClassName Into :%tID,:%tBodyId,:%tBodyClassname From Ens.MessageHeader h
           Where SourceConfigName=:tSourceConfigName and TargetConfigName = :tTargetConfigName and (TimeCreated < :%tDoNotDeleteDate)
          And 0 = ( Select Count(*) From Ens.MessageHeader
                                       Where (SessionId = h.SessionId)
                                        And (Status<>$$$eMessageStatusCompleted)
                                       And (Status<>$$$eMessageStatusAborted)
                                       And (Status<>$$$eMessageStatusError)
                                       And (Status<>$$$eMessageStatusDiscarded)
                                      And SourceConfigName = :tSourceConfigName
                                     And TargetConfigName = :tTargetConfigName

  •                                                                                 Order By TimeCreated
                                                                    )
    1. No Integrity
      1. Old
        • DECLARE C2 CURSOR FOR
                                                                          Select ID,MessageBodyId,MessageBodyClassName Into :%tID,:%tBodyId,:%tBodyClassname From Ens.MessageHeader
           Where SourceConfigName=:tSourceConfigName and TargetConfigName = :tTargetConfigName and (TimeCreated < :%tDoNotDeleteDate))
      2. New
        • DECLARE C2 CURSOR FOR
                                                                          Select ID,MessageBodyId,MessageBodyClassName Into :%tID,:%tBodyId,:%tBodyClassname From Ens.MessageHeader
           Where SourceConfigName=:tSourceConfigName and TargetConfigName = :tTargetConfigName and (TimeCreated < :%tDoNotDeleteDate))
1
0 585
Discussion (2)2
Log in or sign up to continue

Paul,

I have previously written a task that accomplishes a similar goal as what you have described here.

It is not IntereSystems official, but does follow good Ensemble coding practices and has tested well in a handful of scenarios.

The attached task only purges one component at a time.  However, you could easily have multiple tasks each purging a specific component or you can update the code to handle more than one component at a time.

I cannot get the file to upload.  Here is the raw XML:

Include Ensemble

Class Sample.CustomPurgeCriteria Extends (%SYS.Task.Definition, Ens.Util.BitmapPurge) [ System = 4 ]
{

/// How many days of messages should not be purged
Property NumberOfDaysToKeep As %Integer(MINVAL = 0) [ InitialExpression = ];

/// Preserve messages not yet completely processed
Property KeepIntegrity As %Boolean [ InitialExpression = ];

/// Delete message bodies whenever their message header is deleted. This is off by default because some Productions may
/// use message objects that are part of a larger environment and not transitory.
Property BodiesToo As %Boolean [ InitialExpression = ];

/// The type of thing to purge
Property TypesToPurge As %String(DISPLAYLIST = ",All Types,Events,Messages,Business Processes,Rule Logs,I/O Logs,Host Monitor Data,Managed Alerts", VALUELIST = ",all,events,messages,processes,rulelogs,iologs,hostcounters,managedalerts") [ InitialExpression = "events", Required ];

/// The name of the component to purge
/// This only applies to TypesToPurge = 'Messages'
Property SourceConfigName As %String;

/// The OnTask() method is called to execute the task
Method OnTask() As %Status
{
Set tTime = $ZH
    Set tDeletedCount = -1
    Set tBitmapCount = 0
    If ..TypesToPurge = "all" {
Set tSC = ##class(Ens.Purge).PurgeAll(.tDeletedCount,..NumberOfDaysToKeep,..KeepIntegrity,..BodiesToo)
Set (type,tDeletedCount)="" For Set type=$O(tDeletedCount(type),1,count) Quit:""=type  Continue:'count
Set tDeletedCount=tDeletedCount_", "_count_" "_type

Set tDeletedCount=$E(tDeletedCount,3,$L(tDeletedCount)) // get rid of the leading comma and space
Set tBitmapCount = -1
    ElseIf ..TypesToPurge = "events" {
Set tSC = ##class(Ens.Purge).PurgeEventLogsByDate(..NumberOfDaysToKeep,.tDeletedCount,..KeepIntegrity)
    ElseIf ..TypesToPurge = "messages" {
    // Call local Purge() ClassMethod instead of standard code
Set tSC = ..Purge(..NumberOfDaysToKeep,.tDeletedCount,..KeepIntegrity,..BodiesToo,,..SourceConfigName)
Set tDeletedCount=tDeletedCount_$S($G(tDeletedCount("bodies")):"("_tDeletedCount("bodies")_" bodies)",1:"")
// ============================
    ElseIf ..TypesToPurge = "processes" {
Set tSC = ##class(Ens.Purge).PurgeBusinessProcessesByDate(..NumberOfDaysToKeep,.tDeletedCount,..KeepIntegrity)
    ElseIf ..TypesToPurge = "rulelogs" {
Set tSC = ##class(Ens.Purge).PurgeRuleLogsByDate(..NumberOfDaysToKeep,.tDeletedCount,..KeepIntegrity)
    ElseIf ..TypesToPurge = "iologs" {
Set tSC = ##class(Ens.Util.IOLog).Purge(.tDeletedCount,..NumberOfDaysToKeep,..KeepIntegrity)
    ElseIf ..TypesToPurge = "hostcounters" {
Set tSC = ##class(Ens.MonitorService).Purge(.tDeletedCount,..NumberOfDaysToKeep,..KeepIntegrity)
    ElseIf ..TypesToPurge = "managedalerts" {
    Set tSC = ##class(Ens.Alerting.ManagedAlert).Purge(.tDeletedCount,..NumberOfDaysToKeep,..KeepIntegrity)
    ElseIf $ZStrip(..TypesToPurge,"*WC") = "" {
Set tSC = $$$ERROR($$$EnsErrGeneral,"No TypesToPurge specified")
    Else {
Set tSC = $$$ERROR($$$EnsErrGeneral,"Unrecognized TypesToPurge value '"_..TypesToPurge_"'")
    }
    Set tTime = $ZH - tTime
    If $$$ISOK(tSC) {
If (tBitmapCount = 0) {
Set tBitmapCount = +$G(tDeletedCount("bitmaps"))
}
$$$LOGINFO("Purged "_tDeletedCount_" "_..TypesToPurgeLogicalToDisplay(..TypesToPurge)_$S(tBitmapCount>0: " and "_tBitmapCount_" bitmap chunks", 1: "")_" keeping the last "_..NumberOfDaysToKeep_" days with KeepIntegrity="_..KeepIntegrity_$S($Case(..TypesToPurge,"all":1,"messages":1,:0):" and BodiesToo="_..BodiesToo,1:"")_" in "_tTime_"s")
}
Else $$$LOGERROR("Error purging"_..TypesToPurgeLogicalToDisplay(..TypesToPurge)_" keeping the last "_..NumberOfDaysToKeep_" days with KeepIntegrity="_..KeepIntegrity_$S($Case(..TypesToPurge,"all":1,"messages":1,:0):" and BodiesToo="_..BodiesToo,1:"")_" : "_ $$$StatusDisplayString(tSC)) }
Quit tSC
}

/// Purge the message store, and event log
ClassMethod PurgeAll(pTypesToPurge As %String = "all", pNumberOfDaysToKeep As %Integer = 0, pBodiesToo As %Boolean = 1) As %Status
{
Set tTask = ..%New()
Set tTask.TypesToPurge = pTypesToPurge
Set tTask.NumberOfDaysToKeep = pNumberOfDaysToKeep
Set tTask.BodiesToo = pBodiesToo
Quit tTask.OnTask()
}

Method Purge(Output pDeletedCount As %Integer, pDaysToKeep As %Integer = 7, pKeepIntegrity As %Boolean = 1, pBodiesToo As %Boolean = 1, pBitmapChunkLimit As %Integer = 500, pSourceConfigName As %String) As %Status
{

Kill ^CacheTemp.EnsPurgeMessage($Job) // This global will hold errors and warnings for the message purge
Set ^CacheTemp.EnsPurgeMessage($Job) = $ZDT($H,3)
New %tDoNotDeleteDate,%tID,%tBodyId,%tBodyClassname Set %tID="", %tDoNotDeleteDate = $$$timeUTCHtoUTC($s($ztimezone'<0:($H-pDaysToKeep+1)_","_($ztimezone*60),1:($H-pDaysToKeep)_","_($ztimezone*60+86400)))
If '$data($$$EnsJobLocal) New $$$EnsJobLocal Set $$$EnsJobLocal = ""
Set tSC=$$$OK, SQLCODE=0, pDeletedCount=0, pDeletedCount("bodies")=0
If pBodiesToo {
If pKeepIntegrity {
&sql(DECLARE C1 CURSOR FOR
Select TOP 100000000 ID,MessageBodyId,MessageBodyClassName Into :%tID,:%tBodyId,:%tBodyClassname From Ens.MessageHeader h
Where (TimeCreated < :%tDoNotDeleteDate)
--Added filter by component
And(SourceConfigName = :pSourceConfigName)
And 0 = ( Select Count(*) From Ens.MessageHeader
Where (SessionId = h.SessionId)
And (Status<>$$$eMessageStatusCompleted)
And (Status<>$$$eMessageStatusAborted)
And (Status<>$$$eMessageStatusError)
And (Status<>$$$eMessageStatusDiscarded) )
Order By TimeCreated
)
&sql(OPEN C1)
For &sql(FETCH C1)  Quit:SQLCODE
If %tBodyId'="" {
#; Delete body if body class exists and is persistent and ENSPURGE is NOT explicitly set to 0 (i.e. ENSPURGE=1 by default)
Set:""=%tBodyClassname&&(%tBodyId=+%tBodyId) %tBodyClassname="Ens.MessageBody"
If ""'=%tBodyClassname {
Set tExists=$G(aClass(%tBodyClassname))
If 0'=tExists {
If ""=tExists&&'($$$comClassDefined(%tBodyClassname)&&($classmethod(%tBodyClassname,"%IsA","%Persistent")||$classmethod(%tBodyClassname,"%IsA","%Stream.Object")))||($parameter(%tBodyClassname,"ENSPURGE")=0) {
Set aClass(%tBodyClassname)=0
Else {
try {
Set tSC1=$classmethod(%tBodyClassname,"%DeleteId",%tBodyId)
Set:""=tExists aClass(%tBodyClassname)=1, tExists=1 ; , aClass(%tBodyClassname,"extent")=##class(Ens.VDoc.SearchTableGenerator).GetExtentSuperclass(%tBodyClassname)
catch {
Set tSC1 = $$$SystemError
//Set:""=tExists aClass(%tBodyClassname)=0 Set:'$G(aClass(%tBodyClassname,"doneErr")) tSC1=$$$SystemError // This was preventing subsequent messages to be deleted (HCR374)
}
If $$$ISOK(tSC1) || $$$StatusEquals(tSC1,$$$DeleteObjectNotFound,$$$FileCanNotDelete,$$$NotAnInstanceError) {
Set tSC2 = ##class(Ens.SearchTableBase).RemoveSearchTableEntries(%tBodyClassname,%tBodyId,1)
If $$$ISERR(tSC2)&&'$G(aClass(%tBodyClassname,"doneErrST")) && '$$$StatusEquals(tSC2,$$$DeleteObjectNotFound,$$$FileCanNotDelete,$$$NotAnInstanceError) ; || ($$$StatusEquals(tSC2,$$$NotAnInstanceError) && '$classmethod(aClass(%tBodyClassname,"extent"),"%ExistsId",%tBodyId))
//Set aClass(%tBodyClassname,"doneErrST")=1 // This was preventing subsequent message's search table entries to be deleted (HCR374)
Set tMsg = "Failed to purge SearchTable entries for deleted body with BodyClassname='"_%tBodyClassname_"', BodyId='"_%tBodyId_"' from header "_%tID_" :"_$$$StatusDisplayString(tSC2)
Set tSC = ..PurgeSetTemp(3,tMsg,tSC,tSC2)
}
Else //ElseIf '$G(aClass(%tBodyClassname,"doneErr")) { // This was causing inadequate error reporting (HCR374)
//Set aClass(%tBodyClassname,"doneErr")=1 // This was preventing subsequent message bodies to be deleted (HCR374)
Set tMsg = "Failed to purge body for header "_%tID_", BodyClassname='"_%tBodyClassname_"':"_$$$StatusDisplayString(tSC1)
Set tSC = ..PurgeSetTemp(2,tMsg,tSC,tSC1)
}
Set pDeletedCount("bodies")=pDeletedCount("bodies")+$$$ISOK(tSC1)
}
}
}
}
&sql(DELETE From Ens.MessageHeader Where ID = :%tID)
Set pDeletedCount=pDeletedCount+%ROWCOUNT
If SQLCODE {
Set tMsg = "Failed to purge message header "_%tID_": SQLCODE="_SQLCODE Set:$G(%msg)'="" tMsg = tMsg_", %msg="_%msg
Set tSC = ..PurgeSetTemp(1,tMsg,tSC,$$$ERROR($$$EnsErrGeneral,tMsg))
}
Set tCode=SQLCODE &sql(CLOSE C1Set:'SQLCODE SQLCODE=tCode
Else {
&sql(DECLARE C2 CURSOR FOR
Select ID,MessageBodyId,MessageBodyClassName Into :%tID,:%tBodyId,:%tBodyClassname From Ens.MessageHeader
Where (TimeCreated < :%tDoNotDeleteDate)
--Added filter by component
And(SourceConfigName = :pSourceConfigName))
&sql(OPEN C2)
For &sql(FETCH C2)  Quit:SQLCODE
If %tBodyId'="" {
#; Delete body if body class exists and is persistent and ENSPURGE is NOT explicitly set to 0 (i.e. ENSPURGE=1 by default)
Set:""=%tBodyClassname&&(%tBodyId=+%tBodyId) %tBodyClassname="Ens.MessageBody"
If ""'=%tBodyClassname {
Set tExists=$G(aClass(%tBodyClassname))
If 0'=tExists {
If ""=tExists&&'($$$comClassDefined(%tBodyClassname)&&($classmethod(%tBodyClassname,"%IsA","%Persistent")||$classmethod(%tBodyClassname,"%IsA","%Stream.Object")))||($parameter(%tBodyClassname,"ENSPURGE")=0) {
Set aClass(%tBodyClassname)=0
Else {
try {
Set tSC1=$classmethod(%tBodyClassname,"%DeleteId",%tBodyId)
Set:""=tExists aClass(%tBodyClassname)=1, tExists=1 ;, aClass(%tBodyClassname,"extent")=##class(Ens.VDoc.SearchTableGenerator).GetExtentSuperclass(%tBodyClassname)
catch {
Set tSC1 = $$$SystemError
//Set:""=tExists aClass(%tBodyClassname)=0 Set:'$G(aClass(%tBodyClassname,"doneErr")) tSC1=$$$SystemError // This was preventing subsequent messages to be deleted (HCR374)
}
If $$$ISOK(tSC1) || $$$StatusEquals(tSC1,$$$DeleteObjectNotFound,$$$FileCanNotDelete,$$$NotAnInstanceError) {
Set tSC2 = ##class(Ens.SearchTableBase).RemoveSearchTableEntries(%tBodyClassname,%tBodyId,1)
If $$$ISERR(tSC2)&&'$G(aClass(%tBodyClassname,"doneErrST")) && '$$$StatusEquals(tSC2,$$$DeleteObjectNotFound,$$$FileCanNotDelete,$$$NotAnInstanceError) ; || ($$$StatusEquals(tSC2,$$$NotAnInstanceError) && '$classmethod(aClass(%tBodyClassname,"extent"),"%ExistsId",%tBodyId))
//Set aClass(%tBodyClassname,"doneErrST")=1 // This was preventing subsequent message's search table entries to be deleted (HCR374)
Set tMsg = "Failed to purge SearchTable entries for deleted body with BodyClassname='"_%tBodyClassname_"', BodyId='"_%tBodyId_"' from header "_%tID_" :"_$$$StatusDisplayString(tSC2)
Set tSC = ..PurgeSetTemp(3,tMsg,tSC,tSC2)
}
Else //ElseIf '$G(aClass(%tBodyClassname,"doneErr")) { // This was causing inadequate error reporting (HCR374)
//Set aClass(%tBodyClassname,"doneErr")=1 // This was preventing subsequent message bodies to be deleted (HCR374)
Set tMsg = "Failed to purge body for header "_%tID_", BodyClassname='"_%tBodyClassname_"':"_$$$StatusDisplayString(tSC1)
Set tSC = ..PurgeSetTemp(2,tMsg,tSC,tSC1)
}
Set pDeletedCount("bodies")=pDeletedCount("bodies")+$$$ISOK(tSC1)
}
}
}
}
&sql(DELETE From Ens.MessageHeader Where ID = :%tID)
Set pDeletedCount=pDeletedCount+%ROWCOUNT
If SQLCODE {
Set tMsg = "Failed to purge message header "_%tID_": SQLCODE="_SQLCODE Set:$G(%msg)'="" tMsg = tMsg_", %msg="_%msg
Set tSC = ..PurgeSetTemp(1,tMsg,tSC,$$$ERROR($$$EnsErrGeneral,tMsg))
}
Set tCode=SQLCODE &sql(CLOSE C2Set:'SQLCODE SQLCODE=tCode
}
Else {
If pKeepIntegrity {
&sql(DECLARE C3 CURSOR FOR
Select TOP 100000000 ID Into :%tID From Ens.MessageHeader h
Where TimeCreated < :%tDoNotDeleteDate
--Added filter by component
And(SourceConfigName = :pSourceConfigName)
And 0 = ( Select Count(*) From Ens.MessageHeader
Where (SessionId = h.SessionId)
And (Status<>$$$eMessageStatusCompleted)
And (Status<>$$$eMessageStatusAborted)
And (Status<>$$$eMessageStatusError)
And (Status<>$$$eMessageStatusDiscarded) )
Order By TimeCreated
)
&sql(OPEN C3For &sql(FETCH C3)  Quit:SQLCODE
&sql(Delete From Ens.MessageHeader Where ID=:%tID)
Set pDeletedCount=pDeletedCount+%ROWCOUNT
If SQLCODE {
Set tMsg = "Failed to purge message header "_%tID_": SQLCODE="_SQLCODE Set:$G(%msg)'="" tMsg = tMsg_", %msg="_%msg
Set tSC = ..PurgeSetTemp(1,tMsg,tSC,$$$ERROR($$$EnsErrGeneral,tMsg))
}
Set tCode=SQLCODE &sql(CLOSE C3Set:'SQLCODE SQLCODE=tCode
Else {
&sql(DECLARE C4 CURSOR FOR
Select ID Into :%tID From Ens.MessageHeader Where TimeCreated < :%tDoNotDeleteDate)
&sql(OPEN C4For &sql(FETCH C4)  Quit:SQLCODE
Set %ROWCOUNT=0
&sql(Delete From Ens.MessageHeader Where ID=:%tID)
Set pDeletedCount=pDeletedCount+%ROWCOUNT
If SQLCODE {
Set tMsg = "Failed to purge message header "_%tID_": SQLCODE="_SQLCODE Set:$G(%msg)'="" tMsg = tMsg_", %msg="_%msg
Set tSC = ..PurgeSetTemp(1,tMsg,tSC,$$$ERROR($$$EnsErrGeneral,tMsg))
}
Set tCode=SQLCODE &sql(CLOSE C4Set:'SQLCODE SQLCODE=tCode
}
}
Set:SQLCODE&&(SQLCODE'=100) tSC=$$$ADDSC(tSC,$$$ERROR($$$EnsErrGeneral,"Purge error at ID "_$G(%tID)_"; SQLCODE = "_SQLCODE))
Set tBitmapSC = ..PurgeBitmaps(pBitmapChunkLimit,.tDeletedChunks)
Merge pDeletedCount("bitmaps") = tDeletedChunks
Quit $$$ADDSC(tSC,tBitmapSC)
}

/// Log a warning in the Event Log; add to tSC status; set error/warning in a temp global as below: <br>
/// Total error count is in subscript 0. <br>
/// Errors while deleting message headers are in subscript 1. <br>
/// Errors while deleting message bodies are in subscript 2. <br>
/// Errors while deleting search table entries are in subscript 3.
Method PurgeSetTemp(pType As %Integer, pMsg As %String, pSC As %Status, pSC2 As %Status) As %Status
{
$$$LOGWARNING(pMsg)
Set tCount0 = $I(^CacheTemp.EnsPurgeMessage($Job,0))
Set tCount = $I(^CacheTemp.EnsPurgeMessage($Job,pType))
Set:$G(%tID)'="" ^CacheTemp.EnsPurgeMessage($Job,pType,%tID) = pMsg
If tCount0<11 {
Set pSC = $$$ADDSC(pSC,pSC2)
}
ElseIf tCount0=11 {
Set pSC = $$$ADDSC(pSC,$$$ERROR($$$GeneralError,"There are more errors and/or warnings, see the Ensemble Event Log and ^CacheTemp.EnsPurgeMessage("_$Job_") for the full list"))
}
Else {
// do not put into pSC more than 10 messages
}
Quit pSC
}

}