*-------------------------------------------------------------------
* Created by Marco Plaza @vfp2Nofox
* ver 1.100 - 24/02/2016
* enabled collection processing
* ver 1.101 - 24/02/2016
* solved indentation on nested collections
* ver 1.110 -11/03/2016
* -added support for collections inside arrays
* -user can pass aMemembersFlag value
*  ( since Json is intended for DTO creation default value is 'U' )
*   check amembers topic on vfp help file for usage
* changed cr to crlf
* Added Json validation ; throws error for invalid Json.
* ver 1.120
* encode control characters ( chr(0) ~ chr(31) )
*-----------------------------------------------------------------------
Parameters ovfp,FormattedOutput,nonullarrayitem,crootName,aMembersFlag

#Define crlf Chr(13)+Chr(10)

Private All

aMembersFlag = Evl(m.aMembersFlag,'U')

esarray = Type('oVfp',1) = 'A'
esobjeto = Vartype(m.ovfp) = 'O'

If !m.esarray And !m.esobjeto
	Error 'must supply a vfp object/array'
Endif

_nivel = Iif( Cast(m.formattedOutput As l ) , 1, -1)

Do Case
	Case esarray

		ojson = Createobject('empty')

		AddProperty(ojson,'array(1)')
		Acopy(ovfp,ojson.Array)
		cjson = procobject(ojson,.F.,m.nonullarrayitem,m.aMembersFlag)
		cjson = Substr( m.cjson,At('[',m.cjson))


	Case Type('oVfp.BaseClass')='C' And ovfp.BaseClass = 'Collection'
		cjson = procobject(ovfp,.T.,m.nonullarrayitem,m.aMembersFlag)

		crootName    = Evl(m.crootName,'collection')
		cjson = '{"'+m.crootName+collTagName(ovfp)+'": '+cjson+'}'+Iif(FormattedOutput,crlf,'')+'}'

	Otherwise
		cjson = '{'+procobject(ovfp,.F.,m.nonullarrayitem,m.aMembersFlag)+'}'

Endcase


Return Ltrim(cjson)

*----------------------------------------
Function collTagName(thiscoll)
	*----------------------------------------
	Return Iif( m.thiscoll.Count > 0 And !Empty( m.thiscoll.GetKey(1) ), '_kv_collection','_kl_collection' )

	*----------------------------------------------------------------------------------
Function procobject(obt,iscollection,nonullarrayitem,aMembersFlag)
	*----------------------------------------------------------------------------------

	If Isnull(obt)
		Return 'null'
	Endif

	Private All Except _nivel

	este = ''

	xtabs = nivel(2)

	bc = Iif(Type('m.obt.class')='C',m.obt.Class,'?')

	iscollection =  bc = 'Collection'

	If m.iscollection


		este = este+'{ '+xtabs
		xtabs = nivel(2)
		este = este+'"collectionitems": ['+xtabs

		procCollection(obt,m.nonullarrayitem,m.aMembersFlag)

		xtabs = nivel(-2)
		este  = este+xtabs+']'

	Else

		Amembers(am,m.obt,0,m.aMembersFlag)

		If Vartype(m.am) = 'U'
			xtabs=m.nivel(-2)
			Return ''
		Endif


		nm = Alen(am)

		For x1 = 1 To m.nm

			Var = Lower(am(m.x1))

			este = m.este+Iif(m.x1>1,',','')+m.xtabs

			este = m.este+["]+Strtran(m.var,'_vfpsafe_','')+[":]

			esobjeto = Type('m.obt.&Var')='O'

			If Type('m.obt.&var') = 'U'
				este = m.este+["unable to evaluate expression"]
				Loop
			Endif

			esarray  = Type('m.obt.&Var',1) = 'A'

			Do Case

				Case m.esarray

					procarray(obt,m.var,m.nonullarrayitem)

				Case m.esobjeto

					thiso=m.obt.&Var

					bc = Iif(Type('m.thiso.class')='C',m.thiso.Class,'?')

					If bc = 'Collection'

						este = Rtrim(m.este,1,'":')+ collTagName( m.thiso )+'":'

						este =  m.este+procobject(m.obt.&Var,.T.,m.nonullarrayitem,m.aMembersFlag)+[}]

					Else

						este =  m.este+[{]+procobject(m.obt.&Var,.F.,m.nonullarrayitem,m.aMembersFlag)+[}]

					Endif

				Otherwise


					este = este+concatval(m.obt.&Var)

			Endcase

		Endfor


	Endif

	xtabs = nivel(-2)
	este  = este+m.xtabs


	Return m.este


	*----------------------------------------------------
Procedure procarray(obt,arrayName,nonullarrayitem)
	*----------------------------------------------------
	nrows = Alen(m.obt.&arrayName,1)
	ncols = Alen(m.obt.&arrayName,2)
	bidim = m.ncols > 0
	ncols = Iif(m.ncols=0,m.nrows,m.ncols)
	titems = Alen(m.obt.&arrayName)

	xtabs=nivel(2)

	este = m.este+'['+m.xtabs
	nelem = 1

	Do While nelem <= m.titems

		este = este+Iif(m.nelem>1,','+m.xtabs,'')

		If m.bidim
			xtabs = nivel(2)
			este = m.este+'['+m.xtabs
		Endif

		For pn = m.nelem To m.nelem+m.ncols-1

			elem = m.obt.&arrayName( m.pn )

			este = m.este+Iif(m.pn>m.nelem,','+m.xtabs,'')

			If Vartype(m.elem) # 'O'

				If m.nelem+m.ncols-1 = 1 And Isnull(m.elem) And m.nonullarrayitem

					este = m.este+""

				Else
					este = m.este+concatval(m.elem)

				Endif

			Else


				bc = Iif(Type('m.elem.class')='C',m.elem.Class,'?')

				If bc = 'Collection'

					este = m.este+' { "collection'+ collTagName( m.elem )+'":'

					este =  m.este+procobject(m.elem ,.T.,m.nonullarrayitem,m.aMembersFlag)

					este = este + '}'+m.xtabs+'}'

				Else

					este =  m.este+[{]+procobject(m.elem ,.F.,m.nonullarrayitem,m.aMembersFlag)+[}]

				Endif


			Endif

		Endfor

		nelem = m.pn

		If m.bidim
			xtabs=nivel(-2)
			este = m.este+m.xtabs+']'
		Endif

	Enddo


	xtabs=nivel(-2)

	este = m.este+m.xtabs+']'





	*-----------------------------
Function nivel(N)
	*-----------------------------
	If m._nivel = -1
		Return ''
	Else
		_nivel= m._nivel+m.n
		Return crlf+Replicate('  ',m._nivel)
	Endif

	*-----------------------------
Function concatval(valor)
	*-----------------------------

	#Define specialChars ["\/]+Chr(127)+Chr(12)+Chr(10)+Chr(13)+Chr(9)+Chr(0)+Chr(1)+Chr(2)+Chr(3)+Chr(4)+Chr(5)+Chr(6)+Chr(7)+Chr(8)+Chr(9)+Chr(10)+Chr(11)+Chr(12)+Chr(13)+Chr(14)+Chr(15)+Chr(16)+Chr(17)+Chr(18)+Chr(19)+Chr(20)+Chr(21)+Chr(22)+Chr(23)+Chr(24)+Chr(25)+Chr(26)+Chr(27)+Chr(28)+Chr(29)+Chr(30)+Chr(31)

	If Isnull(m.valor)

		Return 'null'

	Else


		tvar = Vartype(m.valor)
		** no cambiar el orden de ejecución!
		Do Case
			Case m.tvar $ 'FBYINQ'
				vc = Rtrim(Cast( m.valor As c(32)))
			Case m.tvar = 'L'
				vc = Iif(m.valor,'true','false')
			Case m.tvar $ 'DT'
				vc = ["]+Ttoc(m.valor,3)+["]
			Case mustEncode(m.valor)
				vc = ["]+escapeandencode(m.valor)+["]
			Case m.tvar $ 'CVM'
				vc = ["]+Rtrim(m.valor)+["]
			Case m.tvar $ 'GQW'
				vc = ["]+Strconv(m.valor,13)+["]
		Endcase

		Return m.vc

	Endif

	*-----------------------------------
Function mustEncode(valor)
	*-----------------------------------
	Return Len(Chrtran(m.valor,specialChars,'')) <> Len(m.valor)

	*-------------------------------
Function escapeandencode(valun)
	*-------------------------------
	valun = Strtran(m.valun,'\','\\')
	valun = Strtran(m.valun,'"','\"')
	*valun = Strtran(m.valun,'/','\/')

	If !mustEncode(m.valun)
		Return
	Endif

	valun = Strtran(m.valun,Chr(127),'\b')
	valun = Strtran(m.valun,Chr(12),'\f')
	valun = Strtran(m.valun,Chr(10),'\n')
	valun = Strtran(m.valun,Chr(13),'\r')
	valun = Strtran(m.valun,Chr(9),'\t')

	If !mustEncode(m.valun)
		Return
	Endif

	Local x
	For x = 0 To 31
		valun = Strtran(m.valun,Chr(m.x),'\u'+Right(Transform(m.x,'@0'),4))
	Endfor

	Return Rtrim(m.valun)



	*---------------------------------------------------------------
Function procCollection(obt,nonullArrayItems,aMembersFlag )
	*---------------------------------------------------------------

	Local iscollection

	With obt

		nm = .Count

		conllave = .Count > 0 And !Empty(.GetKey(1))

		For x1 = 1 To .Count

			If conllave
				elem = Createobject('empty')
				AddProperty(elem,'Key', .GetKey(x1) )
				AddProperty(elem,'Value',.Item(x1))
			Else
				elem = .Item(x1)
			Endif

			este = este+Iif(x1>1,','+xtabs,'')

			If Vartype(elem) # 'O'

				este = este+concatval(m.elem)

			Else

				If Vartype( m.elem.BaseClass ) = 'C' And m.elem.BaseClass = 'Collection'
					iscollection = .T.
					este = m.este+'{ '+m.xtabs+'"collection'+collTagName(m.elem)+'" :'
					xtabs = nivel(2)
				Else
					iscollection = .F.
					m.este = m.este+'{'
				Endif

				este = este+procobject(m.elem, m.iscollection , m.nonullarrayitem, m.aMembersFlag )

				este = este+'}'

				If m.iscollection
					xtabs = nivel(-2)
					este = este+m.xtabs+'}'
				Endif

			Endif

		Endfor

		este = Rtrim(m.este,1,m.xtabs)

	Endwith