Managing @Today in view selection formulas
Using
Everytime that document gets refreshed the field will reflect how the selection formula currently should look like. Then create a view with Server, Database, ViewName -> all 3 columns sorted (ViewName sorting is optional). I called mine
As usual YMMV
@Yesterday, @Today, @Now, @Tomorrow
in Notes view selection formulas is a bad idea (but you know that). But if your application depends on such a selection? The solution is to update your database design automatically with a static date. There are a few caveats:
- You must be careful about date formats, since you don't want code to depend on a locale setting. So
@Date(2012;12;31)
is your save option - After updating a view you want to replicate it across all servers to be sure you don't get design conflicts
- When users use a local replica of your database you want to check the validity of your selection formula in the queryViewOpen event and eventually adjust it there. This would require you control database be available locally (code not shown here)
- Extra care is needed if you have views with duplicate names in your database
lastRun
and finally CurrentSelectionFormula, Text, Computed. Use this formula:
ReplaceStringToday := "@Date("+@Text(@Year(@Today))+";"+@Text(@Month(@Today))+";"+@Text(@Day(@Today))+")";
ReplaceStringYesterday := "@Date("+@Text(@Year(@Yesterday))+";"+@Text(@Month(@Yesterday))+";"+@Text(@Day(@Yesterday))+")";
ReplaceStringTomorrow := "@Date("+@Text(@Year(@Tomorrow))+";"+@Text(@Month(@Tomorrow))+";"+@Text(@Day(@Tomorrow))+")";
@ReplaceSubstring(SelectionFormula; "@Today":"@Now":"@Yesterday":"@Tomorrow"; ReplaceStringToday:ReplaceStringToday:ReplaceStringYesterday:ReplaceStringTomorrow)
Everytime that document gets refreshed the field will reflect how the selection formula currently should look like. Then create a view with Server, Database, ViewName -> all 3 columns sorted (ViewName sorting is optional). I called mine
ViewsToAdjust
. Next step is to populate the documents with views that actually have time related selection formulas. I use this agent for it:
Option Public
Option Declare
Sub Initialize
Dim s As New NotesSession
Dim server As String
Dim dbDir As NotesDbDirectory
Dim reportDB As NotesDatabase
Dim db As NotesDatabase
Set reportDB = s. Currentdatabase
server = reportDB. Server
server = InputBox$ ( "Select Server to scan", "Server selection", server )
If Trim (server ) = "" Then
Exit sub
End If
Set dbDir = s. Getdbdirectory (Server )
Set db = dbDir. Getfirstdatabase (TEMPLATE_CANDIDATE )
Do Until db Is Nothing
Call ProcessDB (reportDB, db )
Set db = dbDir. Getnextdatabase ( )
Loop
End Sub
Sub ProcessDB (reportDB As NotesDatabase, db As NotesDatabase )
On Error GoTo err_ProcessDB
If Not db. Isopen Then
Call db. Open ( "", "" )
If Not db. Isopen Then
Print "Can't open " & db. Title
Exit sub
End If
End If
Print "Processing " & db. Title
Call CreateViewAdjusterForms (reportDB, db )
exit_ProcessDB:
Exit sub
err_ProcessDB:
Print Error$
Resume exit_ProcessDB
End Sub
Sub CreateViewAdjusterForms (reportDB As NotesDatabase, db As NotesDatabase )
Dim doc As NotesDocument
Dim v As NotesView
Dim selectionFormula As String
ForAll curView In db. Views
Set v = curView
SelectionFormula = v. SelectionFormula
If isCriticalProblem (Formula ) Then
Set doc = reportDB. Createdocument ( )
doc. form = "ViewAdjuster"
doc. server = db. Server
doc. database = db. Filepath
doc. viewname = v. Name
doc. SelectionFormula = selectionFormula
Call doc. Computewithform ( true, false )
Call doc. Save ( true, True )
End If
End ForAll
End Sub
Function isCriticalProblem (Formula As String ) As Boolean
Dim work As String
work = LCase$ (Formula )
isCriticalProblem = InStr (work, "now" ) <> 0 Or_
InStr (work, "today" ) <> 0 Or _
InStr (work, "tomorrow" ) <> 0 Or_
InStr (work, "yesterday" ) <> 0
End Function
Once you have the formulas you want to review them if the are really critical and that the revised formula actually will work. Then design a scheduled agent that checks those views. I run it hourly and on all servers (you could use the lastRun date to only check databases that haven't been processed today.To replicate the changed databases I use the catalog.nsf, so you need to make sure that your catalog task is running properly.
Option Declare
Sub Initialize
Dim s As New NotesSession
Dim server As String
Dim dbDir As NotesDbDirectory
Dim reportDB As NotesDatabase
Dim db As NotesDatabase
Set reportDB = s. Currentdatabase
server = reportDB. Server
server = InputBox$ ( "Select Server to scan", "Server selection", server )
If Trim (server ) = "" Then
Exit sub
End If
Set dbDir = s. Getdbdirectory (Server )
Set db = dbDir. Getfirstdatabase (TEMPLATE_CANDIDATE )
Do Until db Is Nothing
Call ProcessDB (reportDB, db )
Set db = dbDir. Getnextdatabase ( )
Loop
End Sub
Sub ProcessDB (reportDB As NotesDatabase, db As NotesDatabase )
On Error GoTo err_ProcessDB
If Not db. Isopen Then
Call db. Open ( "", "" )
If Not db. Isopen Then
Print "Can't open " & db. Title
Exit sub
End If
End If
Print "Processing " & db. Title
Call CreateViewAdjusterForms (reportDB, db )
exit_ProcessDB:
Exit sub
err_ProcessDB:
Print Error$
Resume exit_ProcessDB
End Sub
Sub CreateViewAdjusterForms (reportDB As NotesDatabase, db As NotesDatabase )
Dim doc As NotesDocument
Dim v As NotesView
Dim selectionFormula As String
ForAll curView In db. Views
Set v = curView
SelectionFormula = v. SelectionFormula
If isCriticalProblem (Formula ) Then
Set doc = reportDB. Createdocument ( )
doc. form = "ViewAdjuster"
doc. server = db. Server
doc. database = db. Filepath
doc. viewname = v. Name
doc. SelectionFormula = selectionFormula
Call doc. Computewithform ( true, false )
Call doc. Save ( true, True )
End If
End ForAll
End Sub
Function isCriticalProblem (Formula As String ) As Boolean
Dim work As String
work = LCase$ (Formula )
isCriticalProblem = InStr (work, "now" ) <> 0 Or_
InStr (work, "today" ) <> 0 Or _
InStr (work, "tomorrow" ) <> 0 Or_
InStr (work, "yesterday" ) <> 0
End Function
Option Public
Option Declare
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim catalog As NotesDatabase
Dim v As NotesView
Dim dcol As NotesDocumentCollection
Dim serverName As String
Dim targetDB As NotesDatabase
Dim doc As NotesDocument
Dim dbName As String
Dim dbChanged As Boolean
Set db = s. Currentdatabase
Set catalog = s. getDatabase (db. server, "catalog.nsf" )
Set v = db. Getview ( "ViewsToAdjust" )
servername = db. Server
Set dcol = v. Getalldocumentsbykey (servername, true )
Set doc = dcol. Getfirstdocument ( )
dbChanged = false
Do Until doc Is Nothing
'Get the database if we don't have it already
If dbname <> doc. Getitemvalue ( "database" ) ( 0 ) Then
If Not targetDB Is Nothing And dbChanged Then
Call ReplicateWithAllServers (s, targetDB, catalog )
End If
dbname = doc. Getitemvalue ( "database" ) ( 0 )
Set targetDB = s. Getdatabase (serverName, dbname )
dbChanged = false
End If
'Open if closed
If Not targetDB. Isopen Then
Call targetDB. Open ( "", "" )
End If
'Only process if open worked
If targetDB. Isopen Then
dbChanged = updateOneView (doc,targetDB, dbChanged )
End If
Set doc = dcol. Getnextdocument (doc )
Loop
End Sub
Function updateOneView (doc As NotesDocument,targetDB As NotesDatabase, previousChange As Boolean )
Dim viewName As String
Dim v As NotesView
Dim newFormula As String
Dim formulaInView As String
On Error GoTo Err_updateOneView
'We start with the change status from before
updateOneView = previousChange
viewName = doc. getItemValue ( "ViewName" ) ( 0 )
Set v = targetDB. getView (viewName )
formulaInView = v. Selectionformula
Call doc. Computewithform ( true, true )
newFormula = doc. Getitemvalue ( "CurrentSelectionFormula" ) ( 0 )
'Now check if update is needed
If formulaInView <> newFormula Then
updateOneView = true
v. Selectionformula = newFormula
Call doc. Replaceitemvalue ( "LastRun", date )
Call doc. Save ( true, true )
End If
Exit_updateOneView:
Exit Function
Err_updateOneView:
'TODO: add error reporting here!
Resume Exit_updateOneView
End Function
Sub ReplicateWithAllServers (s As NotesSession, targetDB As NotesDatabase, catalog As NotesDatabase )
Dim v As NotesView
Dim vec As NotesViewEntryCollection
Dim ve As NotesViewEntry
Dim TargetServer As String
Dim sourceName As NotesName
Dim commandString As String
Set sourceName = New NotesName (targetDB. Server )
Set v = catalog. Getview ( "($ReplicaID)" )
Set vec = v. Getallentriesbykey (targetDB. Replicaid, true )
Set ve = vec. Getfirstentry ( )
Do Until ve Is Nothing
targetServer = ve. Columnvalues ( 1 )
If targetServer <> sourceName. Common Then
commandString = "Replicate " & targetServer & " " & targetDB. Filepath & " UPDATE_COLL"
Call s. Sendconsolecommand (targetDB. Server, commandString )
End If
Set ve = vec. Getnextentry (ve )
Loop
End Sub
Option Declare
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim catalog As NotesDatabase
Dim v As NotesView
Dim dcol As NotesDocumentCollection
Dim serverName As String
Dim targetDB As NotesDatabase
Dim doc As NotesDocument
Dim dbName As String
Dim dbChanged As Boolean
Set db = s. Currentdatabase
Set catalog = s. getDatabase (db. server, "catalog.nsf" )
Set v = db. Getview ( "ViewsToAdjust" )
servername = db. Server
Set dcol = v. Getalldocumentsbykey (servername, true )
Set doc = dcol. Getfirstdocument ( )
dbChanged = false
Do Until doc Is Nothing
'Get the database if we don't have it already
If dbname <> doc. Getitemvalue ( "database" ) ( 0 ) Then
If Not targetDB Is Nothing And dbChanged Then
Call ReplicateWithAllServers (s, targetDB, catalog )
End If
dbname = doc. Getitemvalue ( "database" ) ( 0 )
Set targetDB = s. Getdatabase (serverName, dbname )
dbChanged = false
End If
'Open if closed
If Not targetDB. Isopen Then
Call targetDB. Open ( "", "" )
End If
'Only process if open worked
If targetDB. Isopen Then
dbChanged = updateOneView (doc,targetDB, dbChanged )
End If
Set doc = dcol. Getnextdocument (doc )
Loop
End Sub
Function updateOneView (doc As NotesDocument,targetDB As NotesDatabase, previousChange As Boolean )
Dim viewName As String
Dim v As NotesView
Dim newFormula As String
Dim formulaInView As String
On Error GoTo Err_updateOneView
'We start with the change status from before
updateOneView = previousChange
viewName = doc. getItemValue ( "ViewName" ) ( 0 )
Set v = targetDB. getView (viewName )
formulaInView = v. Selectionformula
Call doc. Computewithform ( true, true )
newFormula = doc. Getitemvalue ( "CurrentSelectionFormula" ) ( 0 )
'Now check if update is needed
If formulaInView <> newFormula Then
updateOneView = true
v. Selectionformula = newFormula
Call doc. Replaceitemvalue ( "LastRun", date )
Call doc. Save ( true, true )
End If
Exit_updateOneView:
Exit Function
Err_updateOneView:
'TODO: add error reporting here!
Resume Exit_updateOneView
End Function
Sub ReplicateWithAllServers (s As NotesSession, targetDB As NotesDatabase, catalog As NotesDatabase )
Dim v As NotesView
Dim vec As NotesViewEntryCollection
Dim ve As NotesViewEntry
Dim TargetServer As String
Dim sourceName As NotesName
Dim commandString As String
Set sourceName = New NotesName (targetDB. Server )
Set v = catalog. Getview ( "($ReplicaID)" )
Set vec = v. Getallentriesbykey (targetDB. Replicaid, true )
Set ve = vec. Getfirstentry ( )
Do Until ve Is Nothing
targetServer = ve. Columnvalues ( 1 )
If targetServer <> sourceName. Common Then
commandString = "Replicate " & targetServer & " " & targetDB. Filepath & " UPDATE_COLL"
Call s. Sendconsolecommand (targetDB. Server, commandString )
End If
Set ve = vec. Getnextentry (ve )
Loop
End Sub
As usual YMMV
Posted by Stephan H Wissel on 30 November 2012 | Comments (0) | categories: Show-N-Tell Thursday