wissel.net

Usability - Productivity - Business - The web - Singapore & Twins

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:
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 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 on 21 August 2011 | Comments (2) | categories: Show-N-Tell Thursday

Comments

  1. 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.
  2. 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