Files
vfp_roaauto/COMUN/utile/nfXml/nfxmlread.PRG

292 lines
6.4 KiB
Plaintext

************************************************************************************
* 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
*************************************************************************