************************************************************************************
* nfXMLread ( VFP XML PARSER  )
* Program created by Marco Plaza , 2013-2016  @vfp2nofox
* distributed under VFPX license terms
* revision 1.0100 2016/08/08
* REVISION 1.0500 2016/08/09 
**************************************************************************************
Parameters cXml,_arraysList,xpathExp,_objectTree

#INCLUDE NFXML.H
#Define CRLF Chr(13)+Chr(10)

_arraysList = Lower(','+Evl(m._arraysList,'')+',')

Private All

stackLevels=Astackinfo(aerrs)

If m.stackLevels > 1
	calledFrom = 'called From '+aerrs(m.stackLevels-1,4)+' line '+Transform(aerrs(m.stackLevels-1,5))
Else
	calledFrom = ''
Endif

cError = ''

Do Case
Case Vartype(m.cXml) # 'C'
	xError('nfXML: Must supply a valid Xml string or file name ')
Otherwise
	oXml = nfXmlRead2( cXml,_arraysList,xpathExp , @_objectTree )
Endcase

Return Iif(Vartype(m.oXml)='O',m.oXml,.Null.)

*------------------------------------------------
Procedure xError( cMessage , Lineno )
*------------------------------------------------
Lineno = Evl(m.lineno,'?')
Error 'nfXML ('+m.calledFrom+'): '+CRLF+Transform(m.lineno)+':'+m.cMessage
Return To nfXMLread

*---------------------------------------------------------------
Procedure nfXmlRead2( cXml,_arraysList,xpathExp,_objectTree )
*---------------------------------------------------------------

oMsXml = Createobject('msXml.domdocument')
cError = ''

With oMsXml As msxml.DOMDocument

	.Async = .F.

	If Len(m.cXml) < 200 And File(m.cXml)
		.Load( m.cXml )
	Else
		.LoadXML(m.cXml)
	Endif


	If !Empty(.parseError.reason)

		cError =  'nfXmlRead: '+Transform(.parseError.Line)+') :'+.parseError.reason
		Lineno = 0

	Else


		If Vartype(m.xpathExp) = 'C'

			Try

				oXmlNodes = .selectNodes(m.xpathExp)

			Catch

				cError =  ' invalid XPATH expression ('+m.xpathExp+')'
				Lineno = 0

			Endtry


		Else

			oXmlNodes = .childnodes()

		Endif

		If Vartype(m.oXmlNodes) = 'O' And Empty(m.cError)

			Try
				oVfp = Createobject('empty')
				recnodo(m.oXmlNodes,m.oVfp,'',_arraysList,@_objectTree)
			Catch To oErr
				cError = oErr.Message
				Lineno = oErr.Lineno
			Endtry

		Endif


	Endif

Endwith

If !Empty(m.cError)
	xError( m.cError , m.lineno )
Else
	Return m.oVfp
Endif


*---------------------------------------------------------------------------------
Procedure recnodo( oNodos, esteo , _parentNode , _arraysList , _objectTree )
*---------------------------------------------------------------------------------

Private All


For Each nodo In oNodos

	With nodo


		If .nodeType # 1 And .nodeType # 3
			Loop
		Endif


		esTextNode = .nodeType = 3 Or ( .childnodes.Length = 1 And ( .firstchild.nodeType = 3 Or .firstchild.nodeType = 4 ) )
		emptyNode = .childnodes.Length = 0

		TRY 
			tieneAtributos = .Attributes.Length > 0
		CATCH 
			tieneAtributos = .F.
		ENDTRY 	

		NombreNodo = conv2asc(.nodeName)
		* Sunt cazuri in care comentariul este in interiorul nodului si numele nodului este #text
		IF NombreNodo = "#text"
			Loop
		ENDIF 
		NombreNodoFix = '_'+m.NombreNodo

		nuevoNodo = Type('esteo.&nombreNodo') = 'U' And Type('esteo.&nombreNodoFix') = 'U'

		Do Case
		Case m.emptyNode And !m.tieneAtributos
			nuevoValor = ''
		Case m.esTextNode And !m.tieneAtributos
			nuevoValor = .firstchild.nodeValue
		Otherwise
			nuevoValor = Createobject('empty')
		Endcase

		If m.nuevoNodo

			llSelectNodes = .F.
			TRY 
				llSelectNodes = (.selectNodes('../'+.nodeName).Length >  1)
			CATCH 
			ENDTRY 
			
			If  Lower(','+_parentNode+'.'+.nodeName+'[],') $ m._arraysList Or m.llSelectNodes

				Try
					AddProperty(m.esteo,(m.NombreNodo+'(1)'))

				Catch

					NombreNodo = m.NombreNodoFix

					AddProperty(m.esteo,(m.NombreNodo+'(1)'))

				Endtry

				esteo.&NombreNodo(1) = m.nuevoValor
				elemProc = 'esteo.'+m.NombreNodo+'(1)'
				arrayType = .T.

			Else

				AddProperty(m.esteo,m.NombreNodo,m.nuevoValor)
				elemProc = 'esteo.'+m.NombreNodo
				arrayType = .F.

			Endif

			propertyName = m.NombreNodo

		Else

			If Type('esteo.&nombreNodoFix') = 'U'
				nombreArray = m.NombreNodo
			Else
				nombreArray = m.NombreNodoFix
			Endif

			nvoelem = Alen(esteo.&nombreArray)+1
			nelemx  = Alen(esteo.&nombreArray)

			Dimension esteo.&nombreArray( m.nvoelem )
			esteo.&nombreArray( nvoelem ) = m.nuevoValor
			elemProc = 'esteo.'+m.nombreArray+'('+Transform(m.nvoelem)+')'

			propertyName = m.nombreArray
			arrayType = .T.

		Endif

		If Vartype(m._objectTree) = 'C'

			estaProp = m._parentNode+'.'+m.propertyName+Iif(m.arrayType,'[]','')

			If Not m.estaProp $ m._objectTree
				_objectTree = m._objectTree+ m.estaProp+Iif( .nodeName # m.propertyName,' <= (.'+.nodeName+')','')+CRLF
			Endif

		Endif


		If m.tieneAtributos

			If m.esTextNode
				AddProperty(&elemProc,NODETEXTTAG,.firstchild.nodeValue)

				If Vartype(m._objectTree) = 'C'
					estaProp = m._parentNode+'.'+NODETEXTTAG
					If Not m.estaProp $ m._objectTree
						_objectTree = m._objectTree+m.estaProp+CRLF
					Endif
				Endif


			Endif

			AddProperty(&elemProc,ATTRIBUTETAG,Createobject('empty'))

			oa = m.elemProc+'.'+ATTRIBUTETAG

			For Each atributo In .Attributes

				nombreAtr = conv2asc(atributo.Name)

				Try
					AddProperty(&oa,m.nombreAtr,atributo.Value)
				Catch
					m.nombreAtr = '_'+m.nombreAtr
					AddProperty(&oa,m.nombreAtr,atributo.Value)
				Endtry

				If Vartype(m._objectTree) = 'C'
					estaProp = m._parentNode+'.'+m.propertyName+'.'+ATTRIBUTETAG+'.'+m.nombreAtr
					If Not m.estaProp $ m._objectTree
						_objectTree = m._objectTree+m.estaProp+Iif( atributo.Name # m.nombreAtr,' <= (.'+atributo.Name+')','')+CRLF
					Endif
				Endif

			Endfor

		Endif

		If !m.esTextNode And .childnodes.Length > 0
			=recnodo( .childnodes(), &elemProc , _parentNode+'.'+m.propertyName+Iif(m.arrayType,'[]',''), _arraysList , @_objectTree )
		Endif

	Endwith


Endfor


*------------------------------
Function conv2asc( cTag )
*------------------------------

cTag = Strtran(m.cTag,'_','__')

cTag = Strtran(m.cTag,':','_')
cTag = Strtran(m.cTag,'(','_l_')
cTag = Strtran(m.cTag,')','_r_')
cTag = Strtran(m.cTag,'-','_h_')
cTag = Strtran(m.cTag,'.','_d_')


Return cTag



*************************************************************************