%REM
*********************************************
Library ViewUtils
Created Jan 18, 2016 by Mikhail Cholokov/CRUINTERNET
Description: Comments for Library
%END REM
Option Public
Option Declare
Use "ViewUtilsBase"
%REM
*********************************************
Class ViewNavFlds
Description: for Fields update/create, cached search by key
%END REM
Class ViewNavFlds As ViewNav
Private parent As NotesDocument
Sub New(parent As NotesDocument), ViewNav(FLD_VIEWNAME,parent.Universalid)
'Set me.parent=GetDocumentByUNIDSilent(me.db, me.key)
Set me.parent=parent
End Sub
%REM
*--------------------------------------------
Sub GetHashMap
Description: Comments for Property Get
%END REM
Sub GetHashMap(lst List As Variant)
Dim routineName As String
routineName="GetHashMap"
On Error GoTo ErrH
'your code here
Dim entry As NotesViewEntry, cols List As String, cnt As Long
Set entry=first
Erase lst
Do While Not entry Is Nothing
' Dim idx As Integer
' idx=0
Dim xval
xval=entry.Columnvalues(columns(VALUE_COL))
If IsArrayInitialized(xval) Then xval=xval(0)
'Print {value:}xval
cols(VALUE_COL)=xval
' idx=idx+1
cols(COMMENTS_COL)=entry.Columnvalues(columns(COMMENTS_COL))
' idx=idx+1
cols(DOCORDER_COL)=entry.Columnvalues(columns(DOCORDER_COL))
' idx=idx+1
cols(UNID_COL)=entry.Columnvalues(columns(UNID_COL))
lst(entry.Columnvalues(columns(NAME_COL)))=(cols)
cnt=cnt+1
Set entry=Me.Getnext(entry)
Loop
Print {hash members Count:} cnt
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function Filter
Description: Filter copying update/creating docField
%END REM
Private Function Filter(key As String) As Boolean
Dim routineName As String
routineName="Filter"
On Error GoTo ErrH
'your code here
'filter field with version from update
Filter=IsVersion(key)
'If Me.Filter Then Print {Filtered Key>} key
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function GetKeyValueCol
Description: return column Index (view entry) for hash key
%END REM
Private Function GetKeyValueCol() As Integer
Dim routineName As String
routineName="GetKeyValueCol"
On Error GoTo ErrH
'your code here
GetKeyValueCol=columns(NAME_COL)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function CreateDocument
Description: Comments for Function
%END REM
Private Function CreateDocument(keyfld As String, values) As NotesDocument
Dim routineName As String
routineName="CreateDocument"
On Error GoTo ErrH
'your code here
Dim doc As NotesDocument
Set doc=me.db.CreateDocument()
Call doc.Replaceitemvalue(NAME_FLD, keyfld)
'Dim idx As Integer
Call doc.Replaceitemvalue(VALUE_FLD, values(VALUE_COL))
'idx=idx+1
Call doc.Replaceitemvalue(COMMENTS_FLD, values(COMMENTS_COL))
'idx=idx+1
Dim item As NotesItem
'value of DOCORDER_FLD set to Number
Set item=doc.Replaceitemvalue(DOCORDER_FLD, CInt(values(DOCORDER_COL)))
Call doc.ReplaceItemValue(UNID_FLD, doc.UniversalID)
Call doc.Makeresponse(parent)
Call SetRWAccess(parent, doc)
Set CreateDocument=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function SetType
Description: should be overrided
%END REM
Private Function SetType(doc As NotesDocument)
Dim routineName As String
routineName="SetType"
On Error GoTo ErrH
'your code here
Call doc.Replaceitemvalue(ISTEMPLATE_FLD, Me.IsTemplate)
Call doc.Replaceitemvalue({Form}, FLD_TYPE)
'Call doc.Computewithform(False, False)
Set SetType=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function UpdateValues
Description: assign nev values to entry document
call from base class on update
%END REM
Private Function UpdateValues(values, entry As NotesViewEntry, docres As NotesDocument) As Boolean
Dim routineName As String
routineName="UpdateValues"
On Error GoTo ErrH
'your code here
' Dim idx As Integer
If Len(values(VALUE_COL))>0 Then
If values(VALUE_COL)<>BLANK_TEMPL Then
If values(VALUE_COL)<>entry.Columnvalues(columns(VALUE_COL)) And (Not safe) Then
Set docres=entry.Document
Call docres.Replaceitemvalue(VALUE_FLD,values(VALUE_COL))
UpdateValues=True
End If
End If
End If
' idx=idx+1
If values(COMMENTS_COL)<>entry.Columnvalues(columns(COMMENTS_COL)) Then
Set docres=entry.Document
Call docres.Replaceitemvalue(COMMENTS_FLD,values(COMMENTS_COL))
UpdateValues=True
End If
' idx=idx+1
If values(DOCORDER_COL)<>entry.Columnvalues(columns(DOCORDER_COL)) Then
'value of DOCORDER_FLD set to Number
Set docres=entry.Document
Call docres.Replaceitemvalue(DOCORDER_FLD,CInt(values(DOCORDER_COL)))
UpdateValues=True
End If
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function testOut
Description: Comments for Function
%END REM
Function testOut
Dim routineName As String
routineName="testOut"
On Error GoTo ErrH
'your code here
Dim lst List As Variant
Call Me.GetHashMap(Lst)
me.PrintTrace({********************************************})
ForAll cols In lst
If me.debug Then _
me.PrintTrace(ListTag(cols) &KEY_SEP _
&cols(VALUE_COL) &KEY_SEP _
&cols(COMMENTS_COL) &KEY_SEP _
&cols(DOCORDER_COL))
End ForAll
'testOut=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
End Class
%REM
*********************************************
Class ViewNavTbls
Description: for Fields update/create, cached search by key
%END REM
Class ViewNavTbls As ViewNav
Private parent As NotesDocument
Sub New(parent As NotesDocument), ViewNav(TBL_VIEWNAME, parent.Universalid)
Dim routineName As String
routineName="New"
On Error GoTo ErrH
'your code here
'Set me.parent=GetDocumentByUNIDSilent(me.db, me.key)
Set me.parent=parent
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function CreateDocument
Description: Comments for Function
%END REM
Private Function CreateDocument(keyfld As String, values) As NotesDocument
Dim routineName As String
routineName="CreateDocument"
On Error GoTo ErrH
'your code here
'Print {Class:} TypeName(Me){->} routineName{; Key:}keyfld
Dim doc As NotesDocument
Set doc=me.db.CreateDocument()
Call doc.Replaceitemvalue(PREFIX_FLD,StrLeft(keyfld,PREFIX_SEP))'need for docTables form works right
Call doc.Replaceitemvalue(SUFFIX_FLD,StrRight(keyfld,PREFIX_SEP))'need for docTables form works right
Call doc.Replaceitemvalue(NAME_FLD, keyfld)
Call doc.Replaceitemvalue(SUFFIX_FLD,StrRight(keyfld,PREFIX_SEP))'need for docTables form works right
Call doc.ReplaceItemValue(UNID_FLD, doc.UniversalID)
Dim unid As String, tmp As NotesDocument
unid=values
'get original table doc (see GetHashMap)
Set tmp=GetDocumentByUNIDSilent(me.db, unid)
'copy body RT
Call tmp.Getfirstitem({body}).Copyitemtodocument(doc, {body})
Call doc.Makeresponse(parent)
Call SetRWAccess(parent, doc)
Set CreateDocument=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function Filter
Description: filter docTables with version from update/creste
%END REM
Private Function Filter(key As String) As Boolean
Dim routineName As String
routineName="Filter"
On Error GoTo ErrH
'your code here
'filter tables with version from update/creste
Filter=IsVersion(key)
'If Me.Filter Then Print {Filtered Key>} key
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Sub GetHashMap
Description: Comments for Sub
%END REM
Sub GetHashMap(lst List As Variant)
Dim routineName As String
routineName="GetHashMap"
On Error GoTo ErrH
'your code here
Dim entry As NotesViewEntry, cols List As String, cnt As Long
Erase lst
Set entry=first
'only last unid would be saved if NAME_FLD not unique
Do While Not entry Is Nothing
'Print {NAME_COL:}entry.Columnvalues(columns(NAME_COL))
lst(entry.Columnvalues(columns(NAME_COL)))=entry.Universalid
cnt=cnt+1
Set entry=Me.Getnext(entry)
Loop
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function GetKeyValueCol
Description: Comments for Function
%END REM
Private Function GetKeyValueCol() As Integer
Dim routineName As String
routineName="GetKeyValueCol"
On Error GoTo ErrH
'your code here
GetKeyValueCol=columns(NAME_COL)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function SetType
Description: Comments for Function
%END REM
Private Function SetType(doc As NotesDocument)
Dim routineName As String
routineName="SetType"
On Error GoTo ErrH
'your code here
Call doc.Replaceitemvalue(ISTEMPLATE_FLD, Me.IsTemplate)
Call doc.Replaceitemvalue({Form}, TBL_TYPE)
'Call doc.Computewithform(False, False)
Set SetType=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function UpdateValues
Description: docTables should not be udated
%END REM
Private Function UpdateValues(values, entry As NotesViewEntry, docres As NotesDocument) As Boolean
Dim routineName As String
routineName="UpdateValues"
On Error GoTo ErrH
'your code here
UpdateValues=False
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
End Class
%REM
*********************************************
Class ViewNavFldsPfx
Description: hash only current prefix (type_fld)
main usage is new version for docField
%END REM
Class ViewNavFldsPfx As ViewNav
Private xtype As String
Private parent As NotesDocument
Sub New(key As String), ViewNav(FLD_VIEWNAME,StrLeft(key,KEY_SEP))
Set me.parent=GetDocumentByUNIDSilent(me.db,StrLeft(key,KEY_SEP))
me.xtype=StrRight(key,KEY_SEP)
End Sub
%REM
*--------------------------------------------
Function CreateDocument
Description: Comments for Function
%END REM
Private Function CreateDocument(keyfld As String, values) As NotesDocument
Dim routineName As String
routineName="CreateDocument"
On Error GoTo ErrH
'your code here
Dim doc As NotesDocument
Set doc=me.db.CreateDocument()
Call doc.Replaceitemvalue(NAME_FLD, keyfld)
Call doc.Replaceitemvalue(VALUE_FLD, values(VALUE_COL))
Call doc.Replaceitemvalue(COMMENTS_FLD, values(COMMENTS_COL))
Dim item As NotesItem
'value of DOCORDER_FLD set to Number
Set item=doc.Replaceitemvalue(DOCORDER_FLD, CInt(values(DOCORDER_COL)))
Call doc.ReplaceItemValue(UNID_FLD, doc.UniversalID)
Call doc.Makeresponse(parent)
Call SetRWAccess(parent, doc)
Set CreateDocument=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Sub GetHashMap
Description: Comments for Sub
%END REM
Sub GetHashMap(lst List As Variant)
Dim routineName As String
routineName="GetHashMap"
On Error GoTo ErrH
'your code here
Dim entry As NotesViewEntry, cols List As String, cnt As Long
Set entry=first
Erase lst
Do While Not entry Is Nothing
If InStr(1,entry.Columnvalues(columns(NAME_COL)), me.xtype &PREFIX_SEP)=1 Then
cols(VALUE_COL)=entry.Columnvalues(columns(VALUE_COL))
cols(COMMENTS_COL)=entry.Columnvalues(columns(COMMENTS_COL))
cols(DOCORDER_COL)=entry.Columnvalues(columns(DOCORDER_COL))
cols(UNID_COL)=entry.Columnvalues(columns(UNID_COL))
lst(entry.Columnvalues(columns(NAME_COL)))=(cols)
cnt=cnt+1
End If
Set entry=Me.Getnext(entry)
Loop
Print {hash members Count:} cnt
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function GetKeyValueCol
Description: return Index for key column
%END REM
Private Function GetKeyValueCol() As Integer
Dim routineName As String
routineName="GetKeyValueCol"
On Error GoTo ErrH
'your code here
GetKeyValueCol=columns(NAME_COL)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function SetType
Description: should be overrided
%END REM
Private Function SetType(doc As NotesDocument)
Dim routineName As String
routineName="SetType"
On Error GoTo ErrH
'your code here
Call doc.Replaceitemvalue(ISTEMPLATE_FLD, Me.IsTemplate)
Call doc.Replaceitemvalue({Form}, FLD_TYPE)
'Call doc.Computewithform(False, False)
Set SetType=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function UpdateValues
Description: selected By prefix should not be udated (only create)
%END REM
Private Function UpdateValues(values, entry As NotesViewEntry, docres As NotesDocument) As Boolean
Dim routineName As String
routineName="UpdateValues"
On Error GoTo ErrH
'your code here
UpdateValues=False
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
End Class
%REM
*********************************************
Class ViewNavFull
Description: key is First column and hashMap key as well
hashMap contains entry.ColumnValues
only string (for values) and only last value (if multivalue)
%END REM
Class ViewNavFull As ViewNav
Sub New(viewName As String), ViewNav(viewName,{})
On Error GoTo ErrH
Set me.nav=view.Createviewnav()
'https://www-10.lotus.com/ldd/ddwiki.nsf/dx/Fast_Retrieval_of_View_Data_Using_the_ViewNavigator_Cache
nav.BufferMaxEntries = NAV_BUF
nav.EntryOptions = Vn_entryopt_nocountdata
Set me.first=nav.Getfirst()
Set me.last=nav.Getlast()
'Print {Class:} TypeName(Me) {->} {Entries Count} nav.Count
ForAll col In me.view.Columns
Dim tmp As NotesViewColumn
Set tmp=col
Print {Column name/pos:}tmp.ItemName {/} tmp.Position-1
me.columns(tmp.ItemName)=tmp.Position-1
End ForAll
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
End Sub
%REM
*--------------------------------------------
Function GetHashMap
Description: Comments for Function
%END REM
Sub GetHashMap(lst List As Variant)
Dim routineName As String
routineName="GetHashMap"
On Error GoTo ErrH
'your code here
Dim entry As NotesViewEntry, cols List As String, cnt As Long
Dim key As String
Set entry=first
Erase lst
Do While Not entry Is Nothing
key=CStr(entry.Columnvalues(0))
Dim i As Integer
i=0
ForAll v In entry.Columnvalues
If IsArray(v) Then v=v(UBound(v))
cols(CStr(i))=CStr(v)
i=i+1
End ForAll
lst(key)=(cols)
cnt=cnt+1
Set entry=Me.Getnext(entry)
Loop
Quit:
Exit Sub
ErrH:
Print {Entry lst cnt/current key} cnt {/} key
Error Err, RaiseError
Resume Quit
End Sub
End Class
%REM
*********************************************
Class ViewNavModified
Description: for modified documents processing
fetch entries by parent, hash by unid, update according modified date/time
AutoSave from base class (trying to Save during Delete)
%END REM
Class ViewNavModified As ViewNavBase
Private parent As NotesDocument
Sub New(vName As String, parent As NotesDocument), ViewNavBase(parent.ParentDatabase, vName,parent.Universalid)
Set me.parent=parent
End Sub
%REM
*--------------------------------------------
Function CreateDocument
Description: Comments for Function
%END REM
Private Function CreateDocument(keyfld As String, values) As NotesDocument
Dim routineName As String
routineName="CreateDocument"
On Error GoTo ErrH
'your code here
Dim tmp As NotesDocument,doc As NotesDocument
'get original doc
Set tmp=GetDocumentByUNIDSilent(me.dbsource, keyfld)
Set doc=me.db.CreateDocument()
Call tmp.Copyallitems(doc, True)
doc.Universalid=keyfld
Set CreateDocument=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function GetHashMap
Description: Comments for Function
%END REM
Sub GetHashMap(lst List As Variant)
Dim routineName As String
routineName="GetHashMap"
On Error GoTo ErrH
'your code here
Dim entry As NotesViewEntry, cols List As String, cnt As Long
Set entry=first
Erase lst
Do While Not entry Is Nothing
cols(UNIDDOC_COL)=entry.Columnvalues(columns(UNIDDOC_COL))
cols(MODIFIED_COL)=entry.Columnvalues(columns(MODIFIED_COL))
lst(cols(UNIDDOC_COL))=(cols)
cnt=cnt+1
Set entry=Me.Getnext(entry)
Loop
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function GetKeyValueCol
Description: return column Index (view entry) for hash key
%END REM
Private Function GetKeyValueCol() As Integer
Dim routineName As String
routineName="GetKeyValueCol"
On Error GoTo ErrH
'your code here
GetKeyValueCol=columns(UNIDDOC_COL)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function Save
Description: expose private function from base class
%END REM
Public Function Save()
Dim routineName As String
routineName="Save"
On Error GoTo ErrH
'your code here
Save=ViewNavBase..Save()
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function UpdateValues
Description: assign nev values to entry document
call from base class on update
%END REM
Private Function UpdateValues(values, entry As NotesViewEntry, docres As NotesDocument) As Boolean
Dim routineName As String
routineName="UpdateValues"
On Error GoTo ErrH
'your code here
Dim dt As New NotesDateTime({}), dt1 As New NotesDateTime({})
dt.Lslocaltime=CDat(values(MODIFIED_COL))
dt1.Lslocaltime=entry.Columnvalues(columns(MODIFIED_COL))
If dt.Timedifference(dt1)>0 Then
'Print {time diff:}dt.Timedifference(dt1)
'Print {Compare:}values(MODIFIED_COL){/} entry.Columnvalues(columns(MODIFIED_COL))
Dim tmp As NotesDocument
Set tmp=GetDocumentByUNIDSilent(me.dbsource, values(UNIDDOC_COL))
'Print {Copy modified doc:} me.dbsource.Replicaid {/} values(UNIDDOC_COL)
Set docres=entry.Document
Call tmp.Copyallitems(docres,True)
'Print {Value:} entry.Document.Getitemvalue({value})(0)
UpdateValues=True
End If
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
End Class
%REM
*********************************************
Class ViewNavModifiedWOAS
Description: Disable AutoSave fom base class
%END REM
Class ViewNavModifiedWOAS As ViewNavModified
Sub New(vName As String, parent As NotesDocument), ViewNavModified(vName, parent)
me.AutoSave=False
End Sub
%REM
*--------------------------------------------
Function Save
Description: expose private function from base class
%END REM
Public Function Save()
Dim routineName As String
routineName="Save"
On Error GoTo ErrH
'your code here
Save=ViewNavModified..Save()
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
End Class
Sub Terminate
End Sub
%REM
*--------------------------------------------
Function GetVerNum
Description: returm version number from xName string
%END REM
Function GetVerNum(xName As String) As Integer
Dim routineName As String
routineName="GetVerNum"
On Error GoTo ErrH
'your code here
GetVerNum=(-1)
If Not IsVersion(xName) Then GoTo Quit
Dim ver As String
'get left sting from rightmost VER_SIGN
ver=StrLeftBack(xName, VER_SIGN)
'get version sting
ver=StrRight(UCase(ver),UCase(VER_TMPL))'protect from case sensetive
If Len(ver)>0 Then GetVerNum=CInt(FullTrim(ver))
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Sub SetRWAccess
Description: assign Reader Atuthor access child document according doc
%END REM
Sub SetRWAccess(doc As NotesDocument, child As NotesDocument)
'выставляет права в дочерних документах равными таковым в родительском
On Error GoTo ErrH
ForAll it In doc.Items
Dim itm As NotesItem, citem As NotesItem
Set itm=it
If itm.IsReaders Then
Set citem=child.ReplaceItemValue(itm.Name, itm.Values)
citem.IsReaders=True
ElseIf itm.IsAuthors Then
Set citem=child.ReplaceItemValue(itm.Name, itm.Values)
citem.IsAuthors=True
End If
End ForAll
Quit:
Exit Sub
ErrH:
RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function IsVersion
Description: if xName is version from base name
%END REM
Function IsVersion(xName) As Boolean
Dim routineName As String
routineName="IsVersion"
On Error GoTo ErrH
'your code here
IsVersion=UCase(xName) Like {*} &VER_SIGN &UCase(VER_TMPL) &{*} &VER_SIGN &{*}
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
