Import initial din SVN ROAAUTO/Trunk @HEAD

COMUN/utile/nfXml/NFXML.H

@@ -0,0 +1,2 @@
+#DEFINE NODETEXTTAG '_nodetext_'
+#Define ATTRIBUTETAG '_attr_'

COMUN/utile/nfXml/nfXml Readme.txt

@@ -0,0 +1,76 @@
+************************************************************************************
+* nfXMLread ( VFP XML PARSER  )
+* Program created by Marco Plaza , 2013-2016  @vfp2nofox
+* distributed under VFPX license terms
+* revision 1.0000 2016/07/30
+**************************************************************************************
+*
+* oVfp = nfXMLRead( [cXMLstring|fileName] [, cArraysList, cXpath ])
+* pass xml string, returns a vfp object. ( empty based, requires vfp9 )
+*
+*
+* ARRAYS:
+*
+* Unlike Json, XML does not identify object arrays on the XML document itself,
+* it does it on the XML Schema.
+*
+* To gain simplicity and ease of use, nfXmlRead uses no XML Schema.
+*
+* nfXmlRead identifies arrays by counting the child nodes with identical names;
+* so any node with more than one child node with identical name is identified as array,
+* as no object can contain more than 2 properties with the same name.
+*
+* If you're sure your XML contains no arrays and any contained array will have at least
+* more than one member, you don't need to worry.
+*
+* For any other situation, you can pass a comma separated list of all the properties
+* that must be treated as arrays; The array name should be specified as full object path with open/close brackets,
+* and should contain no spaces. For example,a excel workbook contains the next arrays:
+*
+* '.Workbook.Worksheet[],.Workbook.Worksheet[].Table._Row[],.Workbook.Worksheet[].Table._Row[].cell[]'
+*
+* ( check the excelTest.prg / run from test folder! )
+*
+*-----------------------------------------------------------------------------
+* PROPERTIES WITH SPECIAL CHARACTERS OR SPACES
+*-----------------------------------------------------------------------------
+* XML allows node names with spaces and special characters; nfXml safely
+* converts them to valid vfp property names by replacing them on the following way:
+* ':' by '_'
+* '(' by '_l_'
+* ')' by '_r_'
+* '-' by '_h_'
+* '.' by '_d_'
+*
+*--------------------------------------------------------------------
+* INVALID PROPERTY NAMES will be prepended with '_'
+* for example, you can't have an array called "row" since
+* "row()" is a vfp function, then it gets renamed to _row
+* also names starting with numbers and so on.
+*--------------------------------------------------------------------
+*
+*--------------------------------------------------------------------
+* NODE ATTRIBUTES:
+* any node with attributes will be created as object and will have a
+* object property  called _attr_ wich will hold the node attributes
+*---------------------------------------------------------------------
+*
+* NAMESPACES:
+* Namespaces are prepended to node names, separated by "_"
+* this way ss:Styles gets the vfp property name ss_styles;
+*
+* object properties with "_" should be escaped with additional "_"
+*
+* this way:
+* oxml.customer_id   => <customer:id>
+* oxml.customer__id =>  <customer_id>
+*
+* OPTIONAL PARAMETERS:
+* xpathExp : you can pass any xPath Expression for nfXMLRead to return only
+* the desired node without parsing the entire document; useful for big xml files.
+*
+*
+* ERRORS:
+* program will throw error if you supply invalid xml; manage accordingly.
+*
+************************************************************************************

COMUN/utile/nfXml/nfXmlMap.PRG

@@ -0,0 +1,7 @@
+
+PARAMETERS cXml
+
+cMap = ''
+nfXmlRead( m.cXml,.f.,.f.,@cMap )
+
+RETURN cMap

COMUN/utile/nfXml/nfxmlCREATE.PRG

@@ -0,0 +1,173 @@
+************************************************************************************
+* Program created by Marco Plaza , 2013-2016
+* vfp2nofox@gmail.com
+* @vfp2nofox
+* REVISION 1.0500 2016/08/09
+************************************************************************************
+Parameters ovfp,nofmt
+#INCLUDE NFXML.H
+
+If Vartype(m.ovfp) # 'O' Or Vartype(m.nofmt) # 'L'
+	Error "Invalid parameter type"
+Endif
+
+Private All
+m.crlf = Iif(!m.nofmt,Chr(13)+Chr(10),'')
+
+cxml=''
+=o2xml(m.ovfp,'','',m.crlf)
+
+If Amembers(aa,m.ovfp,0,'U') > 1
+	cxml = '<xml>'+m.cxml+m.crlf+'</xml>'
+Endif
+
+cxml = '<?xml version="1.0" encoding="utf-8"?>'+m.cxml
+
+Return Strconv(m.cxml,9)
+
+*-----------------------------------------------------------
+Function o2xml(esteo,oname,nivel,m.crlf,atributos,atclosetag)
+*-----------------------------------------------------------
+
+oname = Lower(m.oname)
+
+Private All Except cxml
+
+closetag = ''
+
+otag = xtag(m.oname)
+
+np = Amembers(aprop,m.esteo,0,'U')
+
+Do Case
+
+Case atributos
+
+	closetag = m.atclosetag
+
+Case !Empty(m.otag)
+
+	cxml = m.cxml+m.crlf+m.nivel+'<'+m.otag
+
+	If Type('esteo.'+ATTRIBUTETAG) # 'O'
+		cxml = m.cxml+'>'
+	Endif
+
+	If Type('esteo.'+ATTRIBUTETAG) # 'O' Or np > 1
+		closetag = m.crlf+m.nivel+'</'+m.otag+'>'
+	Endif
+
+Endcase
+
+If '' # m.crlf
+	nivel = m.nivel+Space(3)
+Endif
+
+If np > 0
+
+* colocar atributos de 1ero:
+
+	npa = Ascan(aprop,ATTRIBUTETAG,1,-1,1,1)
+
+	If npa > 0
+		=Acopy(aprop,tempa)
+		aprop(1) = tempa(npa)
+		aprop(npa) = tempa(1)
+	Endif
+
+	For Each vari In m.aprop
+
+		esarray  = Type('esteo.&vari',1) = 'A'
+		esobjeto = Type('esteo.&vari') = 'O'
+
+		Do Case
+
+		Case Lower(m.vari) = ATTRIBUTETAG
+
+			=o2xml(esteo.&vari,m.vari,m.nivel,m.crlf, .T. , Iif(m.np > 1,'>','/>') )
+
+
+		Case esarray
+
+			For x = 1 To Alen(esteo.&vari)
+
+				m.ele = esteo.&vari(m.x)
+
+				If Vartype(m.ele) = 'O'
+
+					=o2xml(m.ele,m.vari,m.nivel,m.crlf)
+
+				Else
+
+					valorAxml( m.vari, m.ele , m.atributos , m.nivel )
+
+				Endif
+
+
+			Endfor
+
+		Case esobjeto
+
+			=o2xml(esteo.&vari,m.vari,m.nivel,m.crlf)
+
+		Otherwise
+			valorAxml( m.vari, esteo.&vari , m.atributos , m.nivel )
+
+		Endcase
+
+	Endfor
+
+Endif
+
+
+cxml = m.cxml+m.closetag
+
+
+*------------------------
+Function xtag(kk)
+*------------------------
+
+If Lower(m.kk) == ATTRIBUTETAG Or Lower(M.kk) == NODETEXTTAG
+	Return m.kk
+Endif
+
+tr = Sys(3)
+kk = Strtran(m.kk,'__',m.tr)
+kk = Ltrim( m.kk,1,'_')
+kk = Strtran(m.kk,'_',':')
+kk = Strtran(m.kk,'_l_','(')
+kk = Strtran(m.kk,'_r_',')')
+kk = Strtran(m.kk,'_h_','-')
+kk = Strtran(m.kk,'_d_','.')
+kk = Strtran(m.kk,m.tr,'_')
+
+Return m.kk
+
+*-------------------------------
+Function escapar(valor)
+*-------------------------------
+If Len(Chrtran(m.valor,["'<>&],'')) # Len(m.valor)
+	valor = Strtran(m.valor,[&],[&amp;])
+	valor = Strtran(m.valor,['],[&apos;])
+	valor = Strtran(m.valor,[<],[&lt;])
+	valor = Strtran(m.valor,[>],[&gt;])
+	valor = Strtran(m.valor,["],[&quot;])
+Endif
+
+Return m.valor
+
+*------------------------------------------------------
+Procedure valorAxml( vari, valor , atributos , nivel )
+*------------------------------------------------------
+
+m.xtag = Lower(xtag(m.vari))
+
+Do Case
+Case Lower(m.vari) == NODETEXTTAG
+	m.cxml = m.cxml+m.crlf+m.nivel+escapar(Transform(m.valor))
+Case !atributos
+	m.cxml = m.cxml+m.crlf+m.nivel+'<'+m.xtag+'>'+escapar(Transform(m.valor))+'</'+m.xtag+'>'
+Otherwise
+	m.cxml = m.cxml+' '+m.xtag+'="'+escapar(Transform(m.valor))+'"'
+Endcase
+

COMUN/utile/nfXml/nfxmlread.PRG

@@ -0,0 +1,291 @@
+************************************************************************************
+* 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
+
+
+
+*************************************************************************