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
Public Class OOOInfo
Private s As NotesSession
Private db As NotesDatabase
Private allNab As Variant
Private isError As Boolean
Private errorMsg As String
Private Sub initSessionAndDB
If Me. s Is Nothing Then
Set Me. s = New NotesSession
Set Me. db = s. Currentdatabase
allNab = s. AddressBooks
End If
End Sub
Public Sub new
Call Me. initSessionAndDB
End Sub
%REM
getOOOStatus
Description: Gets the status of one user name, there's the real work
%END REM
Public Function getOOOStatus (who As String ) As OOOResult
Dim result As New OOOResult
Dim doc As NotesDocument
On Error Goto Err_getOOOStatus
Set doc = Me. getUserDoc (who )
If Not doc Is Nothing Then
'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"
End If
Exit_getOOOStatus:
Set getOOOStatus = result
Exit Function
Err_getOOOStatus:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOStatus
End Function
%REM
Function getOOOfromNSF
Description: Given an NSF Name retrieves the OOO Status and message
%END REM
Private Function getOOOfromNSF (server As String, mailFile As String ) As OOOResult
Dim result As New OOOResult
Dim mailDB As NotesDatabase
Dim OOOProfile As NotesDocument
On Error Goto Err_getOOOfromNSF
Call Me. initSessionAndDB
Set mailDB = New NotesDatabase (server, mailFile )
If Not mailDB. Isopen Then
Call mailDB. Open ( "", "" )
End If
If mailDB. Isopen Then
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 ) )
End If
Else
result. Status = "NoOOO"
End If
Else
result. Status = "Error"
result. message = "Can't open mail file:" & mailFile
End If
Exit_getOOOfromNSF:
result. server = server
Set getOOOfromNSF = result
Exit Function
Err_getOOOfromNSF:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOfromNSF
End Function
%REM
Function getISODate
Description: converts a Notes Date-time into ISO date
%END REM
Private Function getISODate (raw As Variant ) As String
Dim cur As NotesDateTime
Set cur = New NotesDateTime (raw )
'ToDo: fix this and get a proper date
getISODate = cur. Dateonly
End Function
%REM
Function getUserDoc
Description: Retrieves the Notes Document with the user information
%END REM
Private Function getUserDoc (who As String ) As NotesDocument
Dim doc As NotesDocument
Dim nab As NotesDatabase
Dim v As NotesView
Dim i As Integer
On Error Goto Err_getUserDoc
'Loop through all NAB to make sure we get him
For i = 0 To Ubound (allNab ) Step 1
Set nab = allNab (i )
If Not nab. IsOpen ( ) Then
Call nab. Open ( "", "" )
End If
If nab. IsOpen ( ) Then
Set v = nab. GetView ( "($Users)" )
If Not v Is Nothing Then
Set doc = v. GetDocumentByKey ( Lcase (who ), True ) '$Users has lowercase keys
If Not doc Is Nothing Then
Exit For
End If
End If
End If
Next
Set getUserDoc = doc
Exit_getUserDoc:
Exit Function
Err_getUserDoc :
Call logError
Set getUserDoc = Nothing
Resume Exit_getUserDoc
End Function
%REM
getOOOStatus
Description: Gets the status of multiple user names
%END REM
Public Function getMultipleOOOStatus (multiWho As OOOMultiInput ) As OOOMultiResult
Dim i As Integer
Dim result As OOOResult
Dim allSource As Variant
allSource = multiWho. InputValues
Set getMultipleOOOStatus = New OOOMultiResult
Call getMultipleOOOStatus. resetSize ( Ubound (allSource ) )
For i = 0 To Ubound (allSource ) Step 1
Set result = Me. getOOOStatus (allSource (i ) )
Call getMultipleOOOStatus. updateResult (result,i )
Next
End Function
End Class
%REM
Class OOOResult
Description: Return values for this user
%END REM
Public Class OOOResult
Public Status As String 'OK, NoOOO, UserUnknown, Error
Public Server As String 'What server does the user come from
Public UserName As String 'The fullName we found
Public InterNetMail As String 'The Internet address
Public returnDate As String '//ToDo Decide on format
Public message As String 'What's the message
End Class
%REM
Class OOOMultiInput
Description: Array for multiple queries
%END REM
Public Class OOOMultiInput
Public InputValues ( ) As String
End Class
%REM
Class OOOMultiResult
Description: Array for multiple output values
%END REM
Public Class OOOMultiResult
Public ResultValues ( ) As OOOResult
Public Sub resetSize (index As Integer )
Redim ResultValues (index )
End Sub
Public Sub updateResult (newResult As OOOResult, index As Integer )
If Ubound (ResultValues ) < index Then
Redim Preserve ResultValues (index )
End If
Set resultValues (index ) = newResult
End Sub
End Class
Specify Private s As NotesSession
Private db As NotesDatabase
Private allNab As Variant
Private isError As Boolean
Private errorMsg As String
Private Sub initSessionAndDB
If Me. s Is Nothing Then
Set Me. s = New NotesSession
Set Me. db = s. Currentdatabase
allNab = s. AddressBooks
End If
End Sub
Public Sub new
Call Me. initSessionAndDB
End Sub
%REM
getOOOStatus
Description: Gets the status of one user name, there's the real work
%END REM
Public Function getOOOStatus (who As String ) As OOOResult
Dim result As New OOOResult
Dim doc As NotesDocument
On Error Goto Err_getOOOStatus
Set doc = Me. getUserDoc (who )
If Not doc Is Nothing Then
'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"
End If
Exit_getOOOStatus:
Set getOOOStatus = result
Exit Function
Err_getOOOStatus:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOStatus
End Function
%REM
Function getOOOfromNSF
Description: Given an NSF Name retrieves the OOO Status and message
%END REM
Private Function getOOOfromNSF (server As String, mailFile As String ) As OOOResult
Dim result As New OOOResult
Dim mailDB As NotesDatabase
Dim OOOProfile As NotesDocument
On Error Goto Err_getOOOfromNSF
Call Me. initSessionAndDB
Set mailDB = New NotesDatabase (server, mailFile )
If Not mailDB. Isopen Then
Call mailDB. Open ( "", "" )
End If
If mailDB. Isopen Then
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 ) )
End If
Else
result. Status = "NoOOO"
End If
Else
result. Status = "Error"
result. message = "Can't open mail file:" & mailFile
End If
Exit_getOOOfromNSF:
result. server = server
Set getOOOfromNSF = result
Exit Function
Err_getOOOfromNSF:
Call logError
result. status = "Error"
result. message = Error$
Resume Exit_getOOOfromNSF
End Function
%REM
Function getISODate
Description: converts a Notes Date-time into ISO date
%END REM
Private Function getISODate (raw As Variant ) As String
Dim cur As NotesDateTime
Set cur = New NotesDateTime (raw )
'ToDo: fix this and get a proper date
getISODate = cur. Dateonly
End Function
%REM
Function getUserDoc
Description: Retrieves the Notes Document with the user information
%END REM
Private Function getUserDoc (who As String ) As NotesDocument
Dim doc As NotesDocument
Dim nab As NotesDatabase
Dim v As NotesView
Dim i As Integer
On Error Goto Err_getUserDoc
'Loop through all NAB to make sure we get him
For i = 0 To Ubound (allNab ) Step 1
Set nab = allNab (i )
If Not nab. IsOpen ( ) Then
Call nab. Open ( "", "" )
End If
If nab. IsOpen ( ) Then
Set v = nab. GetView ( "($Users)" )
If Not v Is Nothing Then
Set doc = v. GetDocumentByKey ( Lcase (who ), True ) '$Users has lowercase keys
If Not doc Is Nothing Then
Exit For
End If
End If
End If
Next
Set getUserDoc = doc
Exit_getUserDoc:
Exit Function
Err_getUserDoc :
Call logError
Set getUserDoc = Nothing
Resume Exit_getUserDoc
End Function
%REM
getOOOStatus
Description: Gets the status of multiple user names
%END REM
Public Function getMultipleOOOStatus (multiWho As OOOMultiInput ) As OOOMultiResult
Dim i As Integer
Dim result As OOOResult
Dim allSource As Variant
allSource = multiWho. InputValues
Set getMultipleOOOStatus = New OOOMultiResult
Call getMultipleOOOStatus. resetSize ( Ubound (allSource ) )
For i = 0 To Ubound (allSource ) Step 1
Set result = Me. getOOOStatus (allSource (i ) )
Call getMultipleOOOStatus. updateResult (result,i )
Next
End Function
End Class
%REM
Class OOOResult
Description: Return values for this user
%END REM
Public Class OOOResult
Public Status As String 'OK, NoOOO, UserUnknown, Error
Public Server As String 'What server does the user come from
Public UserName As String 'The fullName we found
Public InterNetMail As String 'The Internet address
Public returnDate As String '//ToDo Decide on format
Public message As String 'What's the message
End Class
%REM
Class OOOMultiInput
Description: Array for multiple queries
%END REM
Public Class OOOMultiInput
Public InputValues ( ) As String
End Class
%REM
Class OOOMultiResult
Description: Array for multiple output values
%END REM
Public Class OOOMultiResult
Public ResultValues ( ) As OOOResult
Public Sub resetSize (index As Integer )
Redim ResultValues (index )
End Sub
Public Sub updateResult (newResult As OOOResult, index As Integer )
If Ubound (ResultValues ) < index Then
Redim Preserve ResultValues (index )
End If
Set resultValues (index ) = newResult
End Sub
End Class
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
stw