Option Public
Option Declare
Const MAX_ITEMSIZE = 32000

'/**
' *
' * FieldAccess is a universal class to manage large amount of values put into text fields
' * (text, names, readers, authors etc.
' * it manages these large amount by splitting values into multiple fields to overcome
' * the 32k size limit. New fields are created as needed.
' * Good for about 62500 entries
' *
' * v0.1 2009-03-20 : notessensei@sg.ibm.com
' * v0.2 2009-08-16 : removed the maximum number of entries per field
' *                   and replaced with a size calculation
' *
' *
' **/

'// Important: This class doesn't contain production quality error handling, you need to add
'// that for production use. Use OpenLog for best results!

Public Class FieldAccess
	Private AccessFieldName As String 'The base name for the current field
	Private maxNumOfFields As Integer 'Limit the number of fields, to avoid mising data in views	
	Private maxTotal As Integer 'The maximum number of names in total
	Private curTotal As Integer 'The current number of entries
	Private maxSize As Long 'How big can the sum of all entries be
	Private curSize As Long 'How big is the current list
	Private curFieldMembers List As String 'The list of current field entries
	Private fieldCount As Integer 'The current number of fields
	Private initialized As Boolean 'Has the list of names been initialized
	Private doc As NotesDocument 'The current document
	Private fieldType As Integer 'Text, names, reader, author
	
	Sub new(curDoc As NotesDocument, Fieldname As String, NotesItemType As Integer)
		Set Me.doc = curDoc
		Me.AccessFieldName = Fieldname
		Me.maxNumOfFields = 10 'Adjust as needed
		Me.maxSize = Me.maxNumOfFields * MAX_ITEMSIZE 'One could argue that is too low
		Me.curSize = 0 'Not initialized yes
		Me.initialized = False
		Me.fieldType = 0 'No special type
	End Sub
	
	'Need to set the field Name
	Public Property Set fieldName As String
		If Me.AccessFieldName <> fieldName Then
			Me.AccessFieldName = fieldName
			Me.initialized = False
		End If
	End Property
	
	Public Property Get FieldName As String
		fieldName = Me.AccessFieldName
	End Property
	
	'How many entries are in the field right now
	Public Property Get count As Integer
		If Not Me.initialized Then
			Me.initializeFields
		End If
		count = Me.curTotal
	End Property
	
	'Add a entry to the value list
	Public Sub addEntry(entryToAdd As String)
		If Not Me.initialized Then
			Me.initializeFields
		End If
		
		If Not Iselement(Me.curFieldMembers(entryToAdd)) Then
			If Me.maxSize < Me.curSize + Len(entryToAdd) Then
				Error 8000 'We throw an error
			Else
				Me.curFieldMembers(entryToAdd) = entryToAdd
				Me.curTotal = Me.curTotal + 1
				Me.curSize = Me.curSize + Len(entryToAdd)
			End If
		End If	
	End Sub
	
	'Bulk adding of entries. Suitable to pull in entries from getItemValues
	Public Sub addEntries(entriesToAdd As Variant)
		Dim oneEntryToAdd As String
		If Not Isarray(entriesToAdd) Then
			Error 8001 'We won't process something that's not an array
		End If
		Forall curEntry In entriesToAdd
			oneEntryToAdd = curEntry
			Call Me.addEntry(oneEntryToAdd)
		End Forall	
	End Sub
	
	'Entry to remove. Is removed from thefields if exist. If the entry
	'doesn't exist no error is raised
	Public Sub removeEntry(entryToRemove As String)
		If Not Me.initialized Then
			Me.initializeFields
		End If		
		If Iselement(Me.curFieldMembers(entryToRemove)) Then
			Erase Me.curFieldMembers(entryToRemove)
			Me.curTotal = Me.curTotal - 1
			Me.curSize = Me.curSize - Len(entryToRemove)
		End If	
	End Sub
	
	'Bulk removal of Entries. Suitable to pull in values from getItemValues
	Public Sub removeEntries(entriesToRemove As Variant)
		Dim oneEntryToRemove As String
		If Not Isarray(entriesToRemove) Then
			Error 8001 'We won't process something that's not an array
		End If
		Forall curEntry In entriesToRemove
			oneEntryToRemove = curEntry
			Call Me.removeEntry(oneEntryToRemove)
		End Forall	
	End Sub
	
	
	'Checks the fields for the existance of and entry
	Public Function containsValue(valueToLookup As String) As Integer
		If Not Me.initialized Then
			Me.initializeFields
		End If
		containsValue = Iselement(Me.curFieldMembers(valueToLookup))
	End Function
	
	'Saves the changes in fields back to the document
	Public Sub saveField
		Dim curFieldCount As Integer
		Dim tmpCount As Integer
		Dim tmpTotal As Integer		
		Dim tmpMax As Integer
		Dim curEntries() As String
		
		Dim curSize As Long
		
		'We save the values 32k at a time and
		'into fields and remove fields we don't need anymore
		
		curSize = 0
		tmpCount = -1 'The counter gets incremented before the first value is written
		curFieldCount = 1 'We want FieldName_1 as first field!
		ReDim curEntries(1000) 'Preset to 1000 entries to avoid many redim
		ForAll curEntry In Me.curFieldMembers
			If curSize + Len(curEntry) > MAX_ITEMSIZE Then
				'We need to write out the current field and reset the array
				ReDim Preserve curEntries(tmpCount)
				Call Me.SaveToField(curEntries, curFieldCount)
				ReDim curEntries(1000)
				tmpCount = 0
				curSize = 0
				curFieldCount = curFieldCount + 1
			Else
			'We increment the counter here to make sure
			'We don't overshoot at the end
			tmpCount = tmpCount + 1				
			End If
			
			If UBound(curEntries) < tmpCount Then
				'We ran out of space and need to extend
				'Redim preserve is "expensive", so we use increments
				'of 100
				ReDim Preserve curEntries(UBound(curEntries)+100)
			End If
			
			'Save the value and record the size
			curEntries(tmpCount) = curEntry
			curSize = curSize + Len(curEntry)
		
		End ForAll
		
		'We must not forget the last one!
		If curSize > 0 Then
				ReDim Preserve curEntries(tmpCount)
				Call Me.SaveToField(curEntries, curFieldCount)			
		End If
		
		'Remove field we might not need anymore
		Call Me.RemoveFields(curFieldCount+1)
		Me.fieldCount = curFieldCount
		
	End Sub
	
	'Saves one field
	Private Sub SaveToField(curVals As Variant, fieldCountOffset As Integer)
		Dim fieldName As String
		Dim newField As NotesItem
		fieldName = Me.AccessFieldName + "_" + Trim(Cstr(fieldCountOffset))
		If doc.HasItem(fieldName) Then
			Call doc.RemoveItem(fieldName)
		End If
		Set newField = New NotesItem(doc,fieldName,curVals,Me.FieldType)
	End Sub
	
	'Removes fields we don't need
	Private Sub removeFields(startCount As Integer)
		Dim fieldName As String
		Dim newField As NotesItem
		Dim i As Integer
		i = startCount
		
		'We remove fields until we dont have one with
		'the suffix any more
		Do While True
			fieldName = Me.AccessFieldName + "_" + Trim(CStr(i))
			If doc.HasItem(fieldName) Then
				Call doc.RemoveItem(fieldName)
			Else
				Exit do
			End If			
		Loop 
	End Sub
	
	
	'Initialize the fields
	Private Sub initializeFields
		Dim namesField As NotesItem
		Dim i As Integer
		Dim curEntry As String
		Dim curVals As Variant
		If doc.HasItem(Me.AccessFieldName) Then
			Me.curTotal = 0
			'//TODO:Full check for missing 1st field
			i = 1
			Do While True
				curEntry = Me.AccessFieldName+"_"+Trim(Cstr(i))
				If Not doc.HasItem(curEntry) Then
					i = i-1 'We overcounted one, so we step back
					Exit Do
				End If
				curVals = doc.GetItemValue(curEntry)
				'Save the names into a list for processing
				Forall member In curVals
					If Not Iselement(curFieldMembers(member)) Then
						curFieldMembers(member) = member
						Me.curTotal = Me.curTotal + 1
						Me.curSize = Me.curSize + Len(member)
					End If					
				End Forall				
				i = i + 1
			Loop
			Me.fieldCount = 1
		Else
			Me.fieldCount = 0
			Me.curTotal = 0
		End If
		
		Me.initialized = True
	End Sub	
	
End Class



'/**
' *
' * ReaderAccess is a universal class to manage large amount of reader names in a document
' * it manages these large amount by splitting reader names into multiple fields to overcome
' * the 32k size limit. New fields are created as needed.
' * Reader access is tricky since there is a 32k limit for ALL reader fields in a form
' * Good for 62500 entries
' *
' * v0.1 2009-03-20 : notessensei@sg.ibm.com
' *
' *
' *
' **/

Public Class ReaderAccess As FieldAccess
	
	Sub New(curDoc As NotesDocument, Fieldname As String, NotesItemType As Integer)
		'The base class runs first, so we only need to add the changes
		Me.AccessFieldName = "DocReaders"
		Me.fieldType = READERS 'Reader field. Might get overwritten by Name if too many entries
	End Sub
	
	
	%REM
		Sub saveField overwrites FieldAccess.SaveField
		Description: 'Saves the changes in fields back to the document
		There are 2 cases:
		Case 1: Less then 32k -> Works like FieldAccess
		Case 2: More than 32k -> We save multiple Names field and
		                         Populate one group per field and record the summary
		        The group creation migh be done by this class or an extra class in a
		        background agent. Depending on the access to NAB                         
		
	%END REM
	Public Sub saveField
		Dim rgh As ReaderGroupsHandler
	
		'First we remove the access field name since it either is not needed
		'or will be replaced later on
		If me.doc.Hasitem(AccessFieldName) Then
			Me.doc.Removeitem(AccessFieldName)
		End If
		
		If curSize < MAX_ITEMSIZE Then
			Call FieldAccess..saveField()
			'The document might have just dropped below the size
			'so we check if we have a status which would be the
			'indicator for a pre-existing group, which we would remove
			'thereafter
			If me.doc.Hasitem(AccessFieldName+"_status") Then
				Set rgh = New ReaderGroupsHandler(me.doc.Universalid)
				Call rgh.removeObsoleteGroups(1)	
			End If
			Exit sub
		End If
		
		'We save the fields, but as name fields and generate the group names
		'and save these into ONE name field
		Me.fieldType = NAMES
		Call FieldAccess..saveField()
		
		'Now we have multiple fields in the document of type NAMES. We
		'need To generate a group for each of them and add that group to one
		'reader field  
		Dim i As Integer 'the counter
		Dim workFieldName As String
		Dim allGroupNames() As String
		Dim newMembers As Variant
		i = 1 'We have GroupName_1 as start group
		ReDim allGroupNames(50) 'We shrink it before we update the item
		Set rgh = New ReaderGroupsHandler(me.doc.Universalid)
		Do While True
			workFieldName = AccessFieldName + "_" + CStr(i)
			If Not me.doc.Hasitem(workFieldName) Then
				Exit Do
			End If
			newMembers = me.doc.Getitemvalue(workFieldName)
			'Increase the groups if neede
			If UBound(allGroupNames) < i Then
				ReDim Preserve allGroupNames(UBound(allGroupNames)+10)
			End If
			allGroupNames(i-1) = rgh.updateGroup(newMembers, i)
			i = i + 1
		Loop
		
		'Shrink the groupName field
		ReDim Preserve allGroupNames(i-1)
		
		'Write out the reader field
		Dim newField As NotesItem
		Set newField = New NotesItem(me.doc,AccessFieldName,allGroupNames,READERS)
	End Sub
	
End Class
%REM
	Class FieldAccessFactory
	Description: Creates an FieldAccess Class based on the field Type provided
%END REM
Public Class FieldAccessFactory
	
	Private doc As NotesDocument
	
	%REM
		Sub New
		Description: Create a new factory for the current document
	%END REM
	Public Sub New (curDoc As NotesDocument)
		Set me.doc = curDoc
	End Sub
	
	%REM
		Function getFieldAccess
		Description: Returns a FieldAccess class bases on the requested
		field type. Currently only READER fields return a special type
	%END REM
	Public Function getFieldAccess(FieldName As String, FieldType As Integer) As FieldAccess
		
		Dim result As FieldAccess
		
		Select Case FieldType
		Case READERS
			Set result = New ReaderAccess(me.doc, FieldName, FieldType)
		Case Else
			Set result = New FieldAccess(me.doc, FieldName, FieldType)
		End Select	
		 
		 Set getFieldAccess = result
	End Function
	
End Class


%REM
	Class ReaderGroupsHandler
	Description: The object access the public name and address book
	and creates, alters or deletes Groups base on a naming scheme. It doesn't
	need to be the primary name and address book and access could be via mail-in
	into an auxiliary database
%END REM
Public Class ReaderGroupsHandler
	
	Private docID As String 'The identificaton for the document/group
	Private applicationPrefix As String 'The prefix for the application
	Private NAB As NotesDatabase 'The name and addressbook to use (names.nsf)
	Private groupView As NotesView 'The view to look for the groups ($Groups)
	Private changeRequestMailInName As String
	Private nabEditorAccess As Boolean
	Private db As NotesDatabase
	
	%REM
		Sub New
		Description: Create a new handler that is already aware of
		the document name to be handled
	%END REM
	Sub New(curDocumentID As String)
		me.docID = curDocumentID
		Call me.initializeDefaultValues()
	End Sub
	
	%REM
		Function initializeDefaultValues
		Description: Gets the application-prefix for this
		application as well as the NAB and the mailin name for name changes
		Short of having a value in the config document
		we use the replicaid
	%END REM
	Private Sub initializeDefaultValues
		'The prefix consist out of OrgPrefix, AppPrefix, AppID
		Dim s As New NotesSession
		Dim config As NotesDocument
		Dim curUser As NotesName
		Dim groupStartKey As String 'Usually a # or $ to get them away from the usernames
		Dim appID As String 'A value from the config Documet or the replicaID
		Set curUser = New NotesName(s.Username)
		groupStartKey = "#" + curUser.Organization+".apps."
		Set db = s.Currentdatabase
		Set config = db.Getprofiledocument("Config")
		If config.Hasitem("AppID") Then
			appID = config.Getitemvalue("AppID")(0)
		Else
			appID = db.Replicaid
		End If
		
		me.applicationPrefix = groupStartKey + appID + ".readers."
		
		If config.hasItem("NABName") Then
			Set me.NAB = New NotesDatabase(db.Server,config.Getitemvalue("NABName")(0))
		Else
			Set me.NAB = New NotesDatabase(db.Server,"names.nsf")
		End If
		
		'TODO: error handling
		If Not me.NAB.Isopen Then
			Call me.NAB.Open("", "")
		End If
		
		If me.NAB.Queryaccess(s.Username) < ACLLEVEL_EDITOR Then
			me.nabEditorAccess = false	
		Else
			me.nabEditorAccess = true
		End If
		
		If config.Hasitem("changeRequestMailInName") Then
			changeRequestMailInName = config.Getitemvalue("changeRequestMailInName")
		Else
			changeRequestMailInName = "GroupNameChangeRequests"
		End If
		
	End Sub
	
	%REM
		Function updateGroup
		Description: Updates one group at a time
		and returns the exact group name
	%END REM
	Public Function updateGroup(NewMembers As Variant, currentNumber As Integer) As String
		Dim groupName As String
		Dim groupDoc As NotesDocument
		groupName = me.applicationPrefix+me.docID+"_"+CStr(currentNumber)
		
		If me.nabEditorAccess Then
			'Manipulate the group directly
			Set GroupDoc = me.getGroupDoc(GroupName)
			If GroupDoc Is Nothing Then
				'Create a new group document
				Set GroupDoc = New NotesDocument(me.NAB)
				Call GroupDoc.Replaceitemvalue("Form","Group")
				Call GroupDoc.Replaceitemvalue("ListName",groupName)
				Call GroupDoc.Replaceitemvalue("GroupType","2") 'ACL only
				Call GroupDoc.Replaceitemvalue("ListCategory","DBReadAccess")
				Call GroupDoc.Replaceitemvalue("ListDescription","Read access group for nsf:"+db.Title+"; document:"+me.docID+"; don't touch!")
				Call GroupDoc.Computewithform(true, False)
			End If
			Call GroupDoc.Replaceitemvalue("Members", "NewMembers")
			Call GroupDoc.Save(true, True)
		Else
			'File a change request via mail-in
			Call me.createChangeRequest("Update", groupName, NewMembers)
		End If
		
		'We return the groupName for processing in the calling class
		updateGroup = groupName
	End Function
	
	%REM
		Sub removeObsoleteGroups
		Description: Removes obsolete groups when number of people
		has changed or documents get removed
	%END REM
	Public Sub removeObsoleteGroups(startGroupNumber As Integer)
		Dim groupName As String
		Dim workGroupName As String
		Dim workDoc As NotesDocument
		groupName = me.applicationPrefix+me.docID
		If me.nabEditorAccess Then
			'Remove the groups directly
			workGroupName = groupName + "_" + CStr(startGroupNumber)
			Set workDoc = me.getGroupDoc(workGroupName)
			Do Until workDoc Is Nothing
				Call workDoc.Remove(true)
				startGroupNumber = startGroupNumber + 1
				workGroupName = groupName + "_" + CStr(startGroupNumber)
				Set workDoc = me.getGroupDoc(workGroupName)
			Loop
		Else
			'Remove via change request
			Call me.createChangeRequest("Delete", groupName, startGroupNumber)
		End If
	End Sub
	
	%REM
		Sub createChangeRequest
		Description: Creates a mail-in request for create/update or deletion of groups
	%END REM
	Private Sub createChangeRequest(RequestType As String, GroupName As String, Members As Variant)
		Dim mail As NotesDocument
		Dim s As New NotesSession
		Set mail = New NotesDocument(me.db)
		Call mail.Replaceitemvalue("Form", "ChangeRequest")
		Call mail.Replaceitemvalue("RequestType",RequestType)
		Call mail.Replaceitemvalue("ReplicaID",me.db.Replicaid)
		Call mail.Replaceitemvalue("UniversalID",docID)
		Call mail.Replaceitemvalue("Requestor", s.Username)
		Call mail.Replaceitemvalue("GroupName",GroupName)
		Call mail.Replaceitemvalue("Members", Members) 'Members can be the users to add/update or the start number for removal
		'We only SEND, we don't SAVE this request
		Call mail.Send(false, me.changeRequestMailInName )
	End Sub
	
	%REM
		Function getGroupDoc
		Description: Comments for Function
	%END REM
	Private Function getGroupDoc(groupName As String) As NotesDocument
		If me.groupView Is Nothing Then
			Set me.groupView = me.db.Getview("($VIMGroups)")
		End If
		Set getGroupDoc = me.groupView.Getdocumentbykey(groupName, true)
	End Function
	
End Class