Recently, I had a requirement to export a number of documents to XML. The file would then be read into a customers helpdesk, which was not Lotus Notes based.
I have exported to XML before and have kept a Script Library in my "black box" for this very purpose. I did not write the script library, but I will share the code here.
Option Public
Option Declare
%REM
Copyright 2009 TietoEnator Alise (developed by Arturs Mekss)
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and limitations under the License.
%END REM
Type NodeQuery
nodeName As String
subNodeName As String
subNodeValue As String
nth As Integer
End Type
%REM
Version: 0.8.0
Author: AMe
Purpose: This class provides methods for XML structured data processing in LotusScript.
XML structure could be read from files or String variables and/or could be written to files or printed out as Text.
There are methods which can be used in order to modify existing XML structure or XML structure
could be built from scratch
Methods:
- isReady() As Boolean
- parseString(sourceStr As String) As Boolean
- parseFile(sourceFilePath As String) As Boolean
- toStream() As NotesStream
- toText() As Boolean
- toFile(targetFilePath As String)
- appendElementNode(pNode As NotesDOMElementNode, nodeName As String, nodeValue As String, altNodeValue As String) As NotesDOMElementNode
- selectNode(elementNode As NotesDOMElementNode, query As String) As NotesDOMElementNode
- getNodeValue(elementNode As NotesDOMElementNode, altVal As String) As String
Examples:
'1. Build XML from scratch and store to file
Dim xml As XMLProcessor
Dim personNode As NotesDOMElementNode
Set xml = New XMLProcessor("persons")
Set personNode = xml.appendElementNode(Nothing, "person", "", "") 'if parent node is Nothing then root node will be used as parent node
Call xml.appendElementNode(personNode, "name", "Bart", "")
Call xml.appendElementNode(personNode, "sureName", "Simpson", "")
Set personNode = xml.appendElementNode(Nothing, "person", "", "")
Call xml.appendElementNode(personNode, "name", "Jonny", "")
Call xml.appendElementNode(personNode, "sureName", "Bravo", "")
Call xml.toFile("D:\WORK_TMP\xml\persons.xml")
'2. Read XML from file and print it as a plain text
Dim xml As XMLProcessor
Set xml = New XMLProcessor("")
Call xml.parseFile("D:\WORK_TMP\xml\persons.xml")
Call xml.toText()
'3. Read XML from file and get values via selector
Dim xml As XMLProcessor
Dim node As NotesDOMElementNode
Set xml = New XMLProcessor("")
Call xml.parseFile("D:\WORK_TMP\xml\persons.xml")
Set node = xml.selectNode(Nothing, "person:2>name")
MessageBox xml.getNodeValue(node, "-")
Set node = xml.selectNode(Nothing, "person(name=Bart)>sureName")
MessageBox xml.getNodeValue(node, "-")
%END REM
Class XMLProcessor
'General variables
Private session As NotesSession
Private objIsReady As Boolean 'Object is properly initialized
'XSLT variables
Private isXSLTDefined As Boolean
Private XSLT As NotesStream
'InputStream variables
Private InputStream As NotesStream
'OutputStream variables
Private outputStream As NotesStream
'DOM variables
Private domparser As NotesDOMParser
Private domdoc As NotesDOMDocumentNode
Private rootNode As NotesDOMElementNode
'PUBLIC Scope:
Public Sub New(rootNodeName As String)
On Error GoTo errh
Dim piNode As NotesDOMProcessingInstructionNode
Set Me.session = New NotesSession
If rootNodeName <> "" Then
Set domParser=session.CreateDOMParser
Set domdoc = domparser.Document
Set piNode = domdoc.CreateProcessingInstructionNode(|xml|, |version="1.0" encoding="UTF-8"|)
Call domdoc.appendChild(piNode)
Set rootNode = domdoc.CreateElementNode(rootNodeName)
Call domdoc.appendChild(rootNode)
Me.objIsReady = True
End If
Exit Sub
errh: Call Me.onError()
Exit Sub
End Sub
Public Sub Delete
On Error GoTo errh
' -- Closing opened resources
' closing xslt stream
If Me.isXSLTDefined Then Call Me.XSLT.Close()
'closing output stream
If Not Me.outputStream Is Nothing Then Call Me.outputStream.Close
'closing input stream
If Not Me.inputStream Is Nothing Then Call Me.inputStream.Close
Exit Sub
errh: Call Me.onError()
Exit Sub
End Sub
Public Function isReady() As Boolean
isReady = Me.objIsReady
End Function
Public Function parseString(sourceStr As String) As Boolean
On Error GoTo errh
If Me.createDOMParserFromSource(sourceStr) Then
parseString = True
Me.objIsReady = True
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Public Function parseFile(sourceFilePath As String) As Boolean
On Error GoTo errh
Set Me.InputStream = session.CreateStream()
If Me.InputStream.Open(sourceFilePath, "UTF-8") Then
If Me.InputStream.Bytes = 0 Then Error 3000, "File does not exist or is empty: " + sourceFilePath
If Me.createDOMParserFromSource(Me.InputStream) Then
parseFile = True
Me.objIsReady = True
End If
Else
Error 3000, "Can't open " & sourceFilePath
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Function toStream() As NotesStream
On Error GoTo errh
If Me.processOutput("") Then
Set Me.toStream = Me.outputStream
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Public Function toText() As Boolean
On Error GoTo errh
If Me.processOutput("") Then
Print Me.outputStream.Readtext()
Call Me.outputStream.Close
toText = True
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Public Function toFile(targetFilePath As String) As Boolean
On Error GoTo errh
If Me.processOutput(targetFilePath) Then
Call Me.outputStream.Close
toFile = True
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Public Function setXSLT(sourceXSLT As XMLProcessor) As Boolean
On Error GoTo errh
Exit Function 'not implemented yet
If Not sourceXSLT Is Nothing Then
If sourceXSLT.isReady()Then
Set Me.XSLT = sourceXSLT.toStream()
Me.isXSLTDefined = True
End If
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Public Function appendElementNode(pNode As NotesDOMElementNode, nodeName As String, nodeValue As String, altNodeValue As String) As NotesDOMElementNode
On Error GoTo errh
Dim parentNode As NotesDOMElementNode
Dim childNode As NotesDOMElementNode
Dim value As String
If Not Me.objIsReady Then Error 3000, "Error: Object is not fully inicialized"
value = nodeValue
If value = "" Then value = altNodeValue
If pNode Is Nothing Then
Set parentNode = rootNode
Else
Set parentNode = pNode
End If
Set childNode = domdoc.CreateElementNode(nodeName)
If value <> "" Then
Call childNode.AppendChild(domdoc.CreateTextNode(nodeValue))
End If
Call parentNode.appendChild(childNode)
Set appendElementNode = childNode
Exit Function
errh: Call Me.onError()
Exit Function
End Function
%REM
'#AMe (17.09.2009) Get & return node from XML document by selector query
'Supported query syntax:
'E>F (F is a child of E)
'E:n (nth E element in result set, default is the first element)
'E(F=abc) (E which has child node F with value 'abc')
'For example:
'Product>Part:3 this query will return 3rd child Part tag of a Product
%END REM
Public Function selectNode(scope As NotesDOMElementNode, query As String) As NotesDOMElementNode
On Error GoTo errh
Dim nQueryList List As NodeQuery
Dim rvNode As NotesDOMElementNode, scopeNode As NotesDOMElementNode
If Not Me.objIsReady Then Error 3000, "Error: Object is not fully inicialized"
If Me.parseQuery(query, nQueryList) Then
If scope Is Nothing Then
Set scopeNode = rootNode
Else
Set scopeNode = scope
End If
ForAll nq In nQueryList
If nq.subNodeValue <> "" Then
Set rvNode = Me.getNodeByTagNameWithSpecContent(scopeNode, nq.nodeName, nq.subNodeName, nq.subNodeValue)
Else
Set rvNode = Me.getNodeByTagName(scopeNode, nq.nodeName, nq.nth)
End If
If rvNode Is Nothing Then
Exit ForAll
Else
Set scopeNode = rvNode
End If
End ForAll
End If
Set Me.SelectNode = rvNode
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Public Function getNodeValue(elementNode As NotesDOMElementNode, altVal As String) As String
On Error GoTo errh
Dim rv As String
rv = altVal
If Not elementNode Is Nothing Then
If Not elementNode.FirstChild.IsNull Then
rv = elementNode.FirstChild.NodeValue
End If
End If
getNodeValue = rv
Exit Function
errh: Call Me.onError()
Exit Function
End Function
'PRIVATE Scope
Private Sub onError()
Error 3000, " [" & GetThreadInfo( 10 ) & ": " & CStr( Erl ) & "] " & Error
End Sub
Private Function createDOMParserFromSource(source As Variant) As Boolean
On Error GoTo errh
Set Me.domParser = Me.session.CreateDOMParser(source)
Call Me.domParser.Process
Set Me.rootNode = Me.domParser.Document.DocumentElement
Me.createDOMParserFromSource = True
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Private Function processOutput(targetFilePath As String) As Boolean
On Error GoTo errh
If Not Me.objIsReady Then Error 3000, "Error: Object is not fully inicialized"
Set Me.outputStream = session.CreateStream
If targetFilePath <> "" Then
If Me.outputStream.Open(targetFilePath, "utf-8") Then
Call Me.outputStream.Truncate
Else
Error 3000, "Can't open " & targetFilePath
End If
End If
Call Me.domparser.SetOutput(Me.outputStream)
Call Me.domparser.serialize()
If Me.isXSLTDefined Then
Set Me.outputStream = Me.transform()
End If
Me.processOutput = True
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Private Function transform() As NotesStream
On Error GoTo errh
Dim transformedOutputStream As NotesStream
Dim transformer As NotesXSLTransformer
'checking
If Not Me.objIsReady Then Error 3000, "Error: Object is not fully inicialized"
If Not Me.isXSLTDefined Then Error 3000, "Error: XSLT is not defined for transformation"
'transformation
Set transformedOutputStream = Me.session.Createstream()
Set transformer = Me.session.CreateXSLTransformer(Me.outputStream , Me.XSLT , transformedOutputStream)
Call transformer.Process()
Set Me.transform = transformedOutputStream
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Private Function getNodeByTagName(elementNode As NotesDOMElementNode, tagName As String, nth As Integer) As NotesDOMElementNode
On Error GoTo errh
Dim nodeList As NotesDOMNodeList
Dim max As Integer
Set nodeList = elementNode.GetElementsByTagName(tagName)
max = nodeList.NumberOfEntries
If nth <= max Then
Set getNodeByTagName = nodeList.GetItem(nth)
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Private Function getValueByTagName(elementNode As NotesDOMElementNode, tagName As String) As Variant
'#AMe (11.03.2008) Get & return value from XML document by Tag name
On Error GoTo errh
Dim result As Variant
Dim nodeList As NotesDOMNodeList
Dim currNode As NotesDOMElementNode
Dim i As Integer, max As Integer
Set nodeList = elementNode.GetElementsByTagName(tagName)
max = nodeList.NumberOfEntries
If (max > 0) Then
ReDim result(max-1)
For i=1 To max
Set currNode = nodeList.GetItem(i)
If Not currNode.FirstChild.IsNull Then
result(i-1) = currNode.FirstChild.NodeValue
Else
result(i-1) = " "
End If
Next i
Else
ReDim result(0)
End If
Me.getValueByTagName = result
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Private Function parseQuery(query As String, nQueryList List As NodeQuery) As Boolean
On Error GoTo errh
Dim idx As Integer
Dim qLevels As Variant
Dim nth As Integer
Dim tmpStr As String
Dim subNodeName As String, subNodeValue As String
qLevels = Split(query, ">")
ForAll level In qLevels
nth = 1
subNodeName = ""
subNodeValue = ""
If InStr(level, ":") > 0 Then
nth = CInt(StrRightBack(level, ":"))
level = StrLeftBack(level, ":")
End If
If InStr(level, "(") > 0 Then
tmpStr = StrRightBack(level, "(")
tmpStr = Left(tmpStr, Len(tmpStr) - 1)
level = StrLeftBack(level, "(")
nth = 1
If InStr(tmpStr, "=") > 0 Then
subNodeName = StrLeftBack(tmpStr, "=")
subNodeValue = StrRightBack(tmpStr, "=")
Else
subNodeName = tmpStr
End If
End If
nQueryList(CStr(idx)).nodeName = level
nQueryList(CStr(idx)).subNodeName = subNodeName
nQueryList(CStr(idx)).subNodeValue = subNodeValue
nQueryList(CStr(idx)).nth = nth
idx = idx + 1
End ForAll
parseQuery = True
Exit Function
errh: Call Me.onError()
Exit Function
End Function
Private Function getNodeByTagNameWithSpecContent(elementNode As NotesDOMElementNode, tagName As String, containsTag As String, containsValue As String) As NotesDOMElementNode
On Error GoTo errh
Dim nodeList As NotesDOMNodeList
Dim currNode As NotesDOMElementNode
Dim i As Integer, max As Integer
Set Me.getNodeByTagNameWithSpecContent = currNode ' initial value
Set nodeList = elementNode.GetElementsByTagName(tagName)
max = nodeList.NumberOfEntries
If (max > 0) Then
For i=1 To max
Set currNode = nodeList.GetItem(i)
If Me.getValueByTagName(currNode, containsTag)(0) = containsValue Then
Set Me.getNodeByTagNameWithSpecContent = currNode
Exit Function
End If
Next i
End If
Exit Function
errh: Call Me.onError()
Exit Function
End Function
End Class
There does not appear to be any way to get hold of attribute data of a node. It does list the number of attributes, but I can't see a way to obtain the values.
ReplyDeleteFor example:
Normal Usage
In this case I can see there is one attribute. But I cannot get a the name "name" or value "Activity". And I can certainly get the Child Node "Value" and it's content "Normal Usage". But again, not dataType. Any thoughts?
NB. This is not Domino XML but output from a separate application. Or is that my problem? Does this only work for Domino XML and is useless for any other format?
OK. That comment stripped my XML structure. It should have been:
ReplyDelete{Field name="Activity"}{Value dataType="string"}Normal Usage{/Value}{/Field}
(Replace squiggle brackets in the appropriate manner}
Hello, I think that this post is amazing, but, I have a little problem. I need to generate this line:
ReplyDeleteBut, I dont see how to create this.
I use this line
Call xml.appendElementNode(docNode2, "noun", "", ""), I dont know how to insert "the value".
I hope that you can help me.
Luis.
the line is "<_n_o_u_n v_a_l_u_e_=_"purchase_invoice" />
ReplyDelete"
Please, not consider the character "_"