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