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:

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

And here is the code:

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 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

posted by Gernot Hummer on Sunday 21 August 2011 AD:
This is a very interesting approach, Stephan. To me Domino Web Services are very underrated. We are currently working on an XML Hub for easy data extraction from any Domino source (the user has access to) and it works pretty well.

This feature of yours might be interesting in project member statuses of bigger projects, one of the things I could think of.

posted by Stephan H. Wissel on Sunday 21 August 2011 AD:
Gernot, you might be able to save yourself the trouble since a generalized web service engine for Domino is already on offer called soapGate Q! by QCom, unless of course you want to compete with them. Emoticon biggrin.gif

stw