« Disk Inventory X | Main| Brewer's Breakfast »

Expanding a Names List

QuickImage Category Show-n-Tell Thursday LotusScript

Here is an old helper function I've had laying about in my toolkit for a while. It gets the unique members of a list of names or groups. Anyway, here is the code:

'/**
' * function expandNamesList
' * @author: Devin S. Olson
' * @licence: Apache License, Version 2.0
' **/
%REM
Function expandNamesList
Gets the unique members for a list of names and groups.
Conditionally recurses to get all individual members of all sub-groups.

@param directory: Source Address Book database within which to search for groups.
@param source: String or Array of Strings containing the members to expand.

@return Variant: Array of Strings containing the expanded unique members of source. Empty String ("") on error.
%END REM
Function expandNamesList(directory As NotesDatabase, source As Variant) As Variant
Dim extendedInfo As String
Dim result As Variant
On Error GoTo ErrorTrap

Const VIEWNAME = |($VIMGroups)|

Static cachedb As NotesDatabase
Static groupsview As NotesView
Static recursions As Integer

Dim nvent As NotesViewEntry
Dim group As NotesDocument
Dim nongroupnames List As String
Dim subgroupmembers List As Variant
Dim subgroupnongroupnames List As Variant

Dim workingset As Variant
Dim membername As String
Dim sourcetype As String
Dim tag As String
Dim idx As Integer
Dim isRecursive As Boolean


isRecursive = (GetThreadInfo(LIB_LSI_THREAD_PROC) = GetThreadInfo(LIB_LSI_THREAD_CALLPROC))
If isRecursive Then incValue recursions%, 1

If (directory Is Nothing) Then Error ERR_PARAMETER_BLANK,MSG_PARAMETER_BLANK

sourcetype$ = TypeName(source)
extendedInfo$ = |Source Type: | & sourcetype$
Select Case sourcetype$
Case "STRING", "STRING LIST", "STRING( )"
workingset = toArray(source)
If (Not isArrayEmpty(workingset)) Then
workingset = atUnique(workingset)
End If

Case "STRINGLIST"
workingset = toArray(source.content)
If (Not isArrayEmpty(workingset)) Then
workingset = atUnique(workingset)
End If

Case Else
Error ERR_PARAMETER_INVALID,MSG_PARAMETER_INVALID

End Select ' Case sourcetype$

If (cachedb Is Nothing) Then
Set cachedb = directory
Set groupsview = Nothing
ElseIf (getDatabaseKey(cachedb) <> getDatabaseKey(directory)) Then
Set cachedb = directory
Set groupsview = Nothing
End If ' (cachedb Is Nothing)

If (groupsview Is Nothing) Then
extendedInfo$ = |View: | & VIEWNAME
Set groupsview = cachedb.GetView(VIEWNAME)
If (groupsview Is Nothing) Then Error ERR_MISSING_VIEW,MSG_MISSING_VIEW
End If ' groupsview Is Nothing

If IsScalar(workingset) Then workingset = toArray(workingset)

For idx% = LBound(workingset) To UBound(workingset)
extendedInfo$ = |Idx: | & CStr(idx%)
membername$ = Trim$(workingset(idx%))
extendedInfo$ = extendedInfo$ & Chr(10) & |Member Name: | & membername$
tag$ = UCase$(membername$)

If (Len(membername$) > 0) Then
If (Len IsElement(nongroupnames(tag$))) Then
If (Len IsElement(subgroupmembers(tag$))) Then
Set nvent = groupsview.GetEntryByKey(membername$, True)
If (nvent Is Nothing) Then
' membername is NOT a group
nongroupnames(tag$) = membername$

Else
' membername IS a group
Set group = nvent.Document
subgroupmembers(tag$) = getDocItemValue(group, "Members")
End If ' (nvent Is Nothing)
End If ' (IsElement(subgroupmembers(tag$)))
End If ' (IsElement(nongroupnames(tag$)))
End If ' (Len(membername$) > 0)
Next idx%

' recursively expand all subgroups
ForAll subgroup In subgroupmembers
tag$ = ListTag(subgroup)
subgroupnongroupnames(tag$) = expandNamesList(directory, subgroup)
End Forall ' subgroup In subgroupmembers

' combine all the sub group members
ForAll subgroupnames In subgroupnongroupnames
If IsScalar(subgroupnames) Then
membername$ = Trim$(CStr(subgroupnames))
If (Len(membername$) > 0) Then nongroupnames(UCase$(membername$)) = membername$

Else
ForAll element In subgroupnames
membername$ = Trim$(CStr(element))
If (Len(membername$) > 0) Then nongroupnames(UCase$(membername$)) = membername$
End Forall ' element In subgroupnames
End If ' IsScalar(subgroupnames)
End Forall ' subgroupnames In subgroupnongroupnames

result = atUnique(StringListToStringArray(nongroupnames))

ExitPoint:
If isRecursive Then incValue recursions%, -1
expandNamesList = result
Exit Function

ErrorTrap:
On Error GoTo 0
If isRecursive Then extendedInfo$ = extendedInfo$ & Chr(10) & |Recursion Level: | & Format(recursions%, FORMAT_WHOLE_THOUSANDS)
enhLogException LIB_PREFIX, extendedInfo$
result = ""
Resume ExitPoint

End Function ' expandNamesList

Hope this helps!
-Devin

Comments

Gravatar Image1 - Nice. However, the DDE doesn't like these lines:

If (Len IsElement(nongroupnames(tag$))) Then
If (Len IsElement(subgroupmembers(tag$))) Then

There seem to be some extra )'s...

Also some CONST's seem to be missing, the one's in red capitals in the code.

Fred

Gravatar Image2 - @Fred - my apologies. I completely forgot the fact that this function calls several other functions from my other support libraries. I will get the libraries posted later today.

@Toby - thanks, that will be helpful for Java development.

Although I still believe there is a TON of LotusScript development still being done -much of which will remain for a very long time -simply because it is cheaper to maintain working code than to redevelop / redesign using a new architecture / language.



Gravatar Image3 - Hey Devin,
Just in case you need and for posterity sake I have a Java version of this on XSnippets...

{ Link }

Gravatar Image4 - This blog impressed me and over exceeded my expectations. You know how to involve a reader and increase his curiosity to read more.

Post A Comment

:-D:-o:-p:-x:-(:-):-\:angry::banghead;:cool::cry::emb::grin::huh::laugh::lips::rolleyes::sniper:;-)

Search

Wowsers! A Tag Cloud!

Techie Stuff

Links

Referrers

  • No Recent Referers

Googles

MiscLinks