Query your Out-Of-Office status using a web service
In a more distributed working environment presence information becomes more and more important. In the consumer space you "check in" using various services, in the enterprise world where is less important than how, where how stands for: available, busy, unavailable etc. In the Lotus IBM Collaboration world we have multiple sources of status: the Sametime status, your IBM Connections status updates, the IBM LotusLive status and - for longer periods - your email out-of-office status. All but the last can easily kept in sync thanks WildFire. Integrating the OOO service proves a little more tricky since it isn't exposed in a neutral API. So in a first step I designed a web service that can retrieve one or more OOO Status messages. In its first cut it ignores the OOO subject or the id of the requestor, but once you got the base version running it is easy to extend it. A few caveats:
As usual: YMMV
- You can (and probably should) place that web service in its own database. Access control to that database defines who can access that service
- You will need the OpenLog library in that database
- The service should be signed with the server ID, so it can read all mail files
- If you want to make it run across servers, you need to configure the servers to trust each other (check the Admin help for that)
- Since web services don't cache anything it is not the most performant option, so there is improvement potential
- There are 2 methods: one for just one status and one to retrieve a batch of them
PublicClass OOOInfo
Private s AsNotesSession
Private db AsNotesDatabase
Private allNab AsVariant
Private isError AsBoolean
Private errorMsg AsString
PrivateSub initSessionAndDB
IfMe. sIsNothingThen
SetMe. s = NewNotesSession
SetMe. db = s. Currentdatabase
allNab = s. AddressBooks
EndIf
EndSub
PublicSubnew
CallMe. initSessionAndDB
EndSub
%REM
getOOOStatus
Description: Gets the status of one user name, there's the real work
%END REM
PublicFunction getOOOStatus (who AsString)As OOOResult
Dim result AsNew OOOResult
Dim doc AsNotesDocument
OnErrorGoto Err_getOOOStatus
Set doc = Me. getUserDoc(who )
IfNot doc IsNothingThen
'Here is the real work, retrieving the status
Set result = Me. getOOOfromNSF(doc. Getitemvalue("MailServer")(0),doc. Getitemvalue("MailFile")(0))
result. UserName = doc. GetItemValue("FullName")(0)
result. InterNetMail = doc. GetItemValue("InternetAddress")(0)
Else
result. Status = "UserUnknown"
EndIf
Exit_getOOOStatus:
Set getOOOStatus = result
ExitFunction
Err_getOOOStatus:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOStatus
EndFunction
%REM
Function getOOOfromNSF
Description: Given an NSF Name retrieves the OOO Status and message
%END REM
PrivateFunction getOOOfromNSF (server AsString, mailFile AsString)As OOOResult
Dim result AsNew OOOResult
Dim mailDB AsNotesDatabase
Dim OOOProfile AsNotesDocument
OnErrorGoto Err_getOOOfromNSF
CallMe. initSessionAndDB
Set mailDB = NewNotesDatabase(server, mailFile )
IfNot mailDB. IsopenThen
Call mailDB. Open("", "")
EndIf
If mailDB. IsopenThen
Set OOOProfile = mailDB. Getprofiledocument("OutOfOfficeProfile")
If OOOProfile. Hasitem("CurrentStatus")Then
If OOOProfile. Getitemvalue("CurrentStatus")(0) = "0"Then
result. Status = "NoOOO"
Else
result. Status = "OK"
'//TODO: Do we need to specify different messages here?
result. message = OOOProfile. Getitemvalue("GeneralMessage")(0)
result. returnDate = Me. getISODate(OOOProfile. Getitemvalue("FirstDayOut")(0))
EndIf
Else
result. Status = "NoOOO"
EndIf
Else
result. Status = "Error"
result. message = "Can't open mail file:" & mailFile
EndIf
Exit_getOOOfromNSF:
result. server = server
Set getOOOfromNSF = result
ExitFunction
Err_getOOOfromNSF:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOfromNSF
EndFunction
%REM
Function getISODate
Description: converts a Notes Date-time into ISO date
%END REM
PrivateFunction getISODate (raw AsVariant)AsString
Dim cur AsNotesDateTime
Set cur = NewNotesDateTime(raw )
'ToDo: fix this and get a proper date
getISODate = cur. Dateonly
EndFunction
%REM
Function getUserDoc
Description: Retrieves the Notes Document with the user information
%END REM
PrivateFunction getUserDoc (who AsString)AsNotesDocument
Dim doc AsNotesDocument
Dim nab AsNotesDatabase
Dim v AsNotesView
Dim i AsInteger
OnErrorGoto Err_getUserDoc
'Loop through all NAB to make sure we get him
For i = 0ToUbound(allNab )Step1
Set nab = allNab (i )
IfNot nab. IsOpen()Then
Call nab. Open("", "")
EndIf
If nab. IsOpen()Then
Set v = nab. GetView("($Users)")
IfNot v IsNothingThen
Set doc = v. GetDocumentByKey(Lcase(who ), True)'$Users has lowercase keys
IfNot doc IsNothingThen
ExitFor
EndIf
EndIf
EndIf
Next
Set getUserDoc = doc
Exit_getUserDoc:
ExitFunction
Err_getUserDoc :
Call logError
Set getUserDoc = Nothing
Resume Exit_getUserDoc
EndFunction
%REM
getOOOStatus
Description: Gets the status of multiple user names
%END REM
PublicFunction getMultipleOOOStatus (multiWho As OOOMultiInput )As OOOMultiResult
Dim i AsInteger
Dim result As OOOResult
Dim allSource AsVariant
allSource = multiWho. InputValues
Set getMultipleOOOStatus = New OOOMultiResult
Call getMultipleOOOStatus. resetSize(Ubound(allSource ))
For i = 0ToUbound(allSource )Step1
Set result = Me. getOOOStatus(allSource (i ))
Call getMultipleOOOStatus. updateResult(result,i )
Next
EndFunction
EndClass
%REM
Class OOOResult
Description: Return values for this user
%END REM
PublicClass OOOResult
Public Status AsString'OK, NoOOO, UserUnknown, Error
Public Server AsString'What server does the user come from
Public UserName AsString'The fullName we found
Public InterNetMail AsString'The Internet address
Public returnDate AsString'//ToDo Decide on format
Public message AsString'What's the message
EndClass
%REM
Class OOOMultiInput
Description: Array for multiple queries
%END REM
PublicClass OOOMultiInput
Public InputValues ()AsString
EndClass
%REM
Class OOOMultiResult
Description: Array for multiple output values
%END REM
PublicClass OOOMultiResult
Public ResultValues ()As OOOResult
PublicSub resetSize (index AsInteger)
Redim ResultValues (index )
EndSub
PublicSub updateResult (newResult As OOOResult, index AsInteger)
IfUbound(ResultValues ) < index Then
RedimPreserve ResultValues (index )
EndIf
Set resultValues (index ) = newResult
EndSub
EndClass
Specify Private s AsNotesSession
Private db AsNotesDatabase
Private allNab AsVariant
Private isError AsBoolean
Private errorMsg AsString
PrivateSub initSessionAndDB
IfMe. sIsNothingThen
SetMe. s = NewNotesSession
SetMe. db = s. Currentdatabase
allNab = s. AddressBooks
EndIf
EndSub
PublicSubnew
CallMe. initSessionAndDB
EndSub
%REM
getOOOStatus
Description: Gets the status of one user name, there's the real work
%END REM
PublicFunction getOOOStatus (who AsString)As OOOResult
Dim result AsNew OOOResult
Dim doc AsNotesDocument
OnErrorGoto Err_getOOOStatus
Set doc = Me. getUserDoc(who )
IfNot doc IsNothingThen
'Here is the real work, retrieving the status
Set result = Me. getOOOfromNSF(doc. Getitemvalue("MailServer")(0),doc. Getitemvalue("MailFile")(0))
result. UserName = doc. GetItemValue("FullName")(0)
result. InterNetMail = doc. GetItemValue("InternetAddress")(0)
Else
result. Status = "UserUnknown"
EndIf
Exit_getOOOStatus:
Set getOOOStatus = result
ExitFunction
Err_getOOOStatus:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOStatus
EndFunction
%REM
Function getOOOfromNSF
Description: Given an NSF Name retrieves the OOO Status and message
%END REM
PrivateFunction getOOOfromNSF (server AsString, mailFile AsString)As OOOResult
Dim result AsNew OOOResult
Dim mailDB AsNotesDatabase
Dim OOOProfile AsNotesDocument
OnErrorGoto Err_getOOOfromNSF
CallMe. initSessionAndDB
Set mailDB = NewNotesDatabase(server, mailFile )
IfNot mailDB. IsopenThen
Call mailDB. Open("", "")
EndIf
If mailDB. IsopenThen
Set OOOProfile = mailDB. Getprofiledocument("OutOfOfficeProfile")
If OOOProfile. Hasitem("CurrentStatus")Then
If OOOProfile. Getitemvalue("CurrentStatus")(0) = "0"Then
result. Status = "NoOOO"
Else
result. Status = "OK"
'//TODO: Do we need to specify different messages here?
result. message = OOOProfile. Getitemvalue("GeneralMessage")(0)
result. returnDate = Me. getISODate(OOOProfile. Getitemvalue("FirstDayOut")(0))
EndIf
Else
result. Status = "NoOOO"
EndIf
Else
result. Status = "Error"
result. message = "Can't open mail file:" & mailFile
EndIf
Exit_getOOOfromNSF:
result. server = server
Set getOOOfromNSF = result
ExitFunction
Err_getOOOfromNSF:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOfromNSF
EndFunction
%REM
Function getISODate
Description: converts a Notes Date-time into ISO date
%END REM
PrivateFunction getISODate (raw AsVariant)AsString
Dim cur AsNotesDateTime
Set cur = NewNotesDateTime(raw )
'ToDo: fix this and get a proper date
getISODate = cur. Dateonly
EndFunction
%REM
Function getUserDoc
Description: Retrieves the Notes Document with the user information
%END REM
PrivateFunction getUserDoc (who AsString)AsNotesDocument
Dim doc AsNotesDocument
Dim nab AsNotesDatabase
Dim v AsNotesView
Dim i AsInteger
OnErrorGoto Err_getUserDoc
'Loop through all NAB to make sure we get him
For i = 0ToUbound(allNab )Step1
Set nab = allNab (i )
IfNot nab. IsOpen()Then
Call nab. Open("", "")
EndIf
If nab. IsOpen()Then
Set v = nab. GetView("($Users)")
IfNot v IsNothingThen
Set doc = v. GetDocumentByKey(Lcase(who ), True)'$Users has lowercase keys
IfNot doc IsNothingThen
ExitFor
EndIf
EndIf
EndIf
Next
Set getUserDoc = doc
Exit_getUserDoc:
ExitFunction
Err_getUserDoc :
Call logError
Set getUserDoc = Nothing
Resume Exit_getUserDoc
EndFunction
%REM
getOOOStatus
Description: Gets the status of multiple user names
%END REM
PublicFunction getMultipleOOOStatus (multiWho As OOOMultiInput )As OOOMultiResult
Dim i AsInteger
Dim result As OOOResult
Dim allSource AsVariant
allSource = multiWho. InputValues
Set getMultipleOOOStatus = New OOOMultiResult
Call getMultipleOOOStatus. resetSize(Ubound(allSource ))
For i = 0ToUbound(allSource )Step1
Set result = Me. getOOOStatus(allSource (i ))
Call getMultipleOOOStatus. updateResult(result,i )
Next
EndFunction
EndClass
%REM
Class OOOResult
Description: Return values for this user
%END REM
PublicClass OOOResult
Public Status AsString'OK, NoOOO, UserUnknown, Error
Public Server AsString'What server does the user come from
Public UserName AsString'The fullName we found
Public InterNetMail AsString'The Internet address
Public returnDate AsString'//ToDo Decide on format
Public message AsString'What's the message
EndClass
%REM
Class OOOMultiInput
Description: Array for multiple queries
%END REM
PublicClass OOOMultiInput
Public InputValues ()AsString
EndClass
%REM
Class OOOMultiResult
Description: Array for multiple output values
%END REM
PublicClass OOOMultiResult
Public ResultValues ()As OOOResult
PublicSub resetSize (index AsInteger)
Redim ResultValues (index )
EndSub
PublicSub updateResult (newResult As OOOResult, index AsInteger)
IfUbound(ResultValues ) < index Then
RedimPreserve ResultValues (index )
EndIf
Set resultValues (index ) = newResult
EndSub
EndClass
OOOInfo
as your Port type class in the info box (Alt+Enter). If your database's name is ooo.nsf and you called the webservice query you can retrieve the wsdl using a url like this: http://www.myserver.org/ooo.nsf/query?wsdl
. Next stop: The same as XPages based REST service.
As usual: YMMV
Posted by Stephan H Wissel on 21 August 2011 | Comments (2) | categories: Show-N-Tell Thursday