%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