From 5b9ec542cc2f5c3856b78f209b339eb27420cfca Mon Sep 17 00:00:00 2001 From: Marius Date: Tue, 26 Aug 2025 23:01:45 +0300 Subject: [PATCH] commit initial testare api gomag vending master --- CLAUDE.md | 71 ++++ gomag-vending-test.prg | 373 +++++++++++++++++++ nfjson/nfjsoncreate.prg | 381 ++++++++++++++++++++ nfjson/nfjsonread.FXP | Bin 0 -> 12383 bytes nfjson/nfjsonread.prg | 775 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 1600 insertions(+) create mode 100644 CLAUDE.md create mode 100644 gomag-vending-test.prg create mode 100644 nfjson/nfjsoncreate.prg create mode 100644 nfjson/nfjsonread.FXP create mode 100644 nfjson/nfjsonread.prg diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..a4b8f23 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,71 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## Project Overview + +This is a Visual FoxPro 9 project that interfaces with the GoMag e-commerce API. The main component is a script for retrieving product data from GoMag's REST API endpoints. + +## Architecture + +- **Single File Application**: `gomag-vending.prg` - Main Visual FoxPro script +- **Technology**: Visual FoxPro 9 with WinHttp.WinHttpRequest.5.1 for HTTP requests +- **API Integration**: GoMag REST API v1 for product management + +## Core Components + +### gomag-vending.prg +Main script that handles: +- GoMag API authentication using Apikey and ApiShop headers +- HTTP GET requests to retrieve product data +- JSON response parsing and analysis +- File output for API responses (timestamped .json files) +- Error handling and connectivity testing + +### Key Configuration Variables +- `lcApiUrl`: GoMag API endpoint (defaults to product read endpoint) +- `lcApiKey`: GoMag API key (must be configured) +- `lcApiShop`: Shop URL (must be configured) + +## Development Commands + +### Running the Application +```foxpro +DO gomag-vending.prg +``` + +### Testing Connectivity +The script includes a `TestConnectivity()` function for internet connectivity testing. + +## API Integration Details + +### Authentication +- Uses header-based authentication with `Apikey` and `ApiShop` headers +- Requires User-Agent to be different from "PostmanRuntime" + +### Endpoints Used +- Primary: `https://api.gomag.ro/api/v1/product/read/json?enabled=1` +- Supports pagination, filtering by category/brand, and sorting parameters + +### Rate Limiting +- No specific limitations for READ requests +- POST requests limited to ~1 request per second (Leaky Bucket algorithm) + +## File Structure +``` +/ +├── gomag-vending.prg # Main application script +└── gomag_products_*.json # Generated API response files (timestamped) +``` + +## Configuration Requirements + +Before running, update these variables in `gomag-vending.prg:10-15`: +1. `lcApiKey` - Your GoMag API key +2. `lcApiShop` - Your shop URL (e.g., "https://yourstore.gomag.ro") + +## Helper Functions + +- `ParseJsonResponse()` - Basic JSON structure analysis +- `TestConnectivity()` - Internet connectivity testing +- `UrlEncode()` - URL parameter encoding utility \ No newline at end of file diff --git a/gomag-vending-test.prg b/gomag-vending-test.prg new file mode 100644 index 0000000..c5b6809 --- /dev/null +++ b/gomag-vending-test.prg @@ -0,0 +1,373 @@ +*-- Script Visual FoxPro 9 pentru accesul la GoMag API cu paginare completa +*-- Autor: Claude AI +*-- Data: 26.08.2025 + +*-- Setari principale +LOCAL lcApiBaseUrl, lcApiUrl, lcApiKey, lcUserAgent, lcContentType +LOCAL loHttp, lcResponse, lcJsonResponse +LOCAL laHeaders[10], lnHeaderCount +Local lcApiShop, lcCsvFileName, lcErrorResponse, lcFileName, lcLogContent, lcLogFileName, lcPath +Local lcStatusText, lnStatusCode, loError +Local lnLimit, lnCurrentPage, llHasMorePages, loAllJsonData, lnTotalPages, lnTotalProducts +PRIVATE gcAppPath, loJsonData + + + +gcAppPath = ADDBS(JUSTPATH(SYS(16,0))) +SET DEFAULT TO (m.gcAppPath) +lcPath = gcAppPath + 'nfjson;' +SET PATH TO (m.lcPath) ADDITIVE + +SET PROCEDURE TO nfjsonread.prg ADDITIVE + +*-- Configurare API - MODIFICA aceste valori conform documentatiei GoMag +lcApiBaseUrl = "https://api.gomag.ro/api/v1/product/read/json?enabled=1" && URL de baza pentru lista de produse +lcApiKey = "4c5e46df8f6c4f054fe2787de7a13d4a" && Cheia ta API de la GoMag +lcApiShop = "https://www.coffeepoint.ro" && URL-ul magazinului tau (ex: http://yourdomain.gomag.ro) +lcUserAgent = "Mozilla/5.0" && User-Agent diferit de PostmanRuntime conform documentatiei +lcContentType = "application/json" +lnLimit = 100 && Numarul maxim de produse per pagina (1-100) +lnCurrentPage = 1 && Pagina de start +llHasMorePages = .T. && Flag pentru paginare +loAllJsonData = NULL && Obiect pentru toate datele + +*-- Verificare daca avem WinHttp disponibil +TRY + loHttp = CREATEOBJECT("WinHttp.WinHttpRequest.5.1") +CATCH TO loError + ? "Eroare la crearea obiectului WinHttp: " + loError.Message + RETURN .F. +ENDTRY + +*-- Bucla pentru preluarea tuturor produselor (paginare) +loAllJsonData = CREATEOBJECT("Empty") +ADDPROPERTY(loAllJsonData, "products", CREATEOBJECT("Empty")) +ADDPROPERTY(loAllJsonData, "total", 0) +ADDPROPERTY(loAllJsonData, "pages", 0) +lnTotalProducts = 0 + +DO WHILE llHasMorePages + *-- Construire URL cu paginare + lcApiUrl = lcApiBaseUrl + "&page=" + TRANSFORM(lnCurrentPage) + "&limit=" + TRANSFORM(lnLimit) + + ? "Preluare pagina " + TRANSFORM(lnCurrentPage) + "..." + + *-- Configurare request + TRY + *-- Initializare request GET + loHttp.Open("GET", lcApiUrl, .F.) + + *-- Setare headers conform documentatiei GoMag + loHttp.SetRequestHeader("User-Agent", lcUserAgent) + loHttp.SetRequestHeader("Content-Type", lcContentType) + loHttp.SetRequestHeader("Accept", "application/json") + loHttp.SetRequestHeader("Apikey", lcApiKey) && Header pentru API Key + loHttp.SetRequestHeader("ApiShop", lcApiShop) && Header pentru shop URL + + *-- Setari timeout + loHttp.SetTimeouts(30000, 30000, 30000, 30000) && 30 secunde pentru fiecare + + *-- Trimitere request + loHttp.Send() + + *-- Verificare status code + lnStatusCode = loHttp.Status + lcStatusText = loHttp.StatusText + + IF lnStatusCode = 200 + *-- Success - preluare raspuns + lcResponse = loHttp.ResponseText + + *-- Parsare JSON cu nfjson + SET PATH TO nfjson ADDITIVE + loJsonData = nfJsonRead(lcResponse) + + IF !ISNULL(loJsonData) + *-- Prima pagina - setam informatiile generale + IF lnCurrentPage = 1 + IF TYPE('loJsonData.total') = 'C' OR TYPE('loJsonData.total') = 'N' + loAllJsonData.total = VAL(TRANSFORM(loJsonData.total)) + ENDIF + IF TYPE('loJsonData.pages') = 'C' OR TYPE('loJsonData.pages') = 'N' + loAllJsonData.pages = VAL(TRANSFORM(loJsonData.pages)) + ENDIF + ? "Total produse: " + TRANSFORM(loAllJsonData.total) + ? "Total pagini: " + TRANSFORM(loAllJsonData.pages) + ENDIF + + *-- Adaugare produse din pagina curenta + IF TYPE('loJsonData.products') = 'O' + DO MergeProducts WITH loAllJsonData, loJsonData + ENDIF + + *-- Verificare daca mai sunt pagini + IF TYPE('loJsonData.pages') = 'C' OR TYPE('loJsonData.pages') = 'N' + lnTotalPages = VAL(TRANSFORM(loJsonData.pages)) + IF lnCurrentPage >= lnTotalPages + llHasMorePages = .F. + ENDIF + ELSE + *-- Daca nu avem info despre pagini, verificam daca sunt produse + IF TYPE('loJsonData.products') != 'O' + llHasMorePages = .F. + ENDIF + ENDIF + + lnCurrentPage = lnCurrentPage + 1 + + ELSE + *-- Salvare raspuns JSON raw in caz de eroare de parsare + lcFileName = "gomag_error_page" + TRANSFORM(lnCurrentPage) + "_" + DTOS(DATE()) + "_" + STRTRAN(TIME(), ":", "") + ".json" + STRTOFILE(lcResponse, lcFileName) + llHasMorePages = .F. + ENDIF + + ELSE + *-- Eroare HTTP - salvare in fisier de log + lcLogFileName = "gomag_error_page" + TRANSFORM(lnCurrentPage) + "_" + DTOS(DATE()) + "_" + STRTRAN(TIME(), ":", "") + ".log" + lcLogContent = "HTTP Error " + TRANSFORM(lnStatusCode) + ": " + lcStatusText + CHR(13) + CHR(10) + + *-- Incearca sa citesti raspunsul pentru detalii despre eroare + TRY + lcErrorResponse = loHttp.ResponseText + IF !EMPTY(lcErrorResponse) + lcLogContent = lcLogContent + "Error Details:" + CHR(13) + CHR(10) + lcErrorResponse + ENDIF + CATCH + lcLogContent = lcLogContent + "Could not read error details" + ENDTRY + + STRTOFILE(lcLogContent, lcLogFileName) + llHasMorePages = .F. + ENDIF + + CATCH TO loError + *-- Salvare erori in fisier de log pentru pagina curenta + lcLogFileName = "gomag_error_page" + TRANSFORM(lnCurrentPage) + "_" + DTOS(DATE()) + "_" + STRTRAN(TIME(), ":", "") + ".log" + lcLogContent = "Script Error on page " + TRANSFORM(lnCurrentPage) + ":" + CHR(13) + CHR(10) +; + "Error Number: " + TRANSFORM(loError.ErrorNo) + CHR(13) + CHR(10) +; + "Error Message: " + loError.Message + CHR(13) + CHR(10) +; + "Error Line: " + TRANSFORM(loError.LineNo) + STRTOFILE(lcLogContent, lcLogFileName) + llHasMorePages = .F. + ENDTRY + + *-- Pauza scurta intre cereri pentru a evita rate limiting + IF llHasMorePages + INKEY(1) && Pauza de 1 secunda + ENDIF + +ENDDO + +*-- Creare fisier CSV cu toate produsele +IF !ISNULL(loAllJsonData) AND TYPE('loAllJsonData.products') = 'O' + lcCsvFileName = "gomag_all_products_" + DTOS(DATE()) + "_" + STRTRAN(TIME(), ":", "") + ".csv" + DO CreateCsvFromJson WITH loAllJsonData, lcCsvFileName + ? "Fisier CSV creat: " + lcCsvFileName + + *-- Salvare si a datelor JSON complete + lcJsonFileName = "gomag_all_products_" + DTOS(DATE()) + "_" + STRTRAN(TIME(), ":", "") + ".json" + DO SaveCompleteJson WITH loAllJsonData, lcJsonFileName + ? "Fisier JSON complet creat: " + lcJsonFileName +ENDIF + +*-- Curatare +loHttp = NULL + +*-- Functie pentru unirea produselor din toate paginile +PROCEDURE MergeProducts +PARAMETERS tloAllData, tloPageData + +LOCAL lnPropCount, lnIndex, lcPropName, loProduct + +*-- Verifica daca avem produse in pagina curenta +IF TYPE('tloPageData.products') = 'O' + *-- Itereaza prin toate produsele din pagina + lnPropCount = AMEMBERS(laPageProducts, tloPageData.products, 0) + + FOR lnIndex = 1 TO lnPropCount + lcPropName = laPageProducts(lnIndex) + loProduct = EVALUATE('tloPageData.products.' + lcPropName) + + IF TYPE('loProduct') = 'O' + *-- Adauga produsul la colectia principala + ADDPROPERTY(tloAllData.products, lcPropName, loProduct) + ENDIF + ENDFOR +ENDIF + +ENDPROC + +*-- Functie pentru salvarea datelor JSON complete +PROCEDURE SaveCompleteJson +PARAMETERS tloJsonData, tcFileName + +LOCAL lcJsonContent + +*-- Construieste JSON simplu pentru salvare +lcJsonContent = '{' + CHR(13) + CHR(10) +lcJsonContent = lcJsonContent + ' "total": ' + TRANSFORM(tloJsonData.total) + ',' + CHR(13) + CHR(10) +lcJsonContent = lcJsonContent + ' "pages": ' + TRANSFORM(tloJsonData.pages) + ',' + CHR(13) + CHR(10) +lcJsonContent = lcJsonContent + ' "products": {' + CHR(13) + CHR(10) + +*-- Adauga produsele (versiune simplificata) +LOCAL lnPropCount, lnIndex, lcPropName, loProduct +lnPropCount = AMEMBERS(laProducts, tloJsonData.products, 0) + +FOR lnIndex = 1 TO lnPropCount + lcPropName = laProducts(lnIndex) + loProduct = EVALUATE('tloJsonData.products.' + lcPropName) + + IF TYPE('loProduct') = 'O' + lcJsonContent = lcJsonContent + ' "' + lcPropName + '": {' + + IF TYPE('loProduct.id') = 'C' + lcJsonContent = lcJsonContent + '"id": "' + loProduct.id + '",' + ENDIF + IF TYPE('loProduct.sku') = 'C' + lcJsonContent = lcJsonContent + '"sku": "' + loProduct.sku + '",' + ENDIF + IF TYPE('loProduct.name') = 'C' + lcJsonContent = lcJsonContent + '"name": "' + STRTRAN(loProduct.name, '"', '\"') + '",' + ENDIF + + *-- Elimina ultima virgula + IF RIGHT(lcJsonContent, 1) = ',' + lcJsonContent = LEFT(lcJsonContent, LEN(lcJsonContent) - 1) + ENDIF + + lcJsonContent = lcJsonContent + '}' + + IF lnIndex < lnPropCount + lcJsonContent = lcJsonContent + ',' + ENDIF + + lcJsonContent = lcJsonContent + CHR(13) + CHR(10) + ENDIF +ENDFOR + +lcJsonContent = lcJsonContent + ' }' + CHR(13) + CHR(10) +lcJsonContent = lcJsonContent + '}' + CHR(13) + CHR(10) + +STRTOFILE(lcJsonContent, tcFileName) + +ENDPROC + +*-- Functie pentru crearea fisierului CSV din datele JSON +PROCEDURE CreateCsvFromJson +PARAMETERS tloJsonData, tcCsvFileName + +LOCAL lcCsvContent, lcCsvHeader, lcCsvRow +LOCAL lnProductCount, lnIndex +LOCAL loProduct + +lcCsvContent = "" +lcCsvHeader = "ID,SKU,Name,Brand,Weight,Stock,Base_Price,Price,VAT_Included,Enabled,VAT,Currency,Ecotax" + CHR(13) + CHR(10) +lcCsvContent = lcCsvHeader + +*-- Verifica daca avem produse in raspuns +IF TYPE('tloJsonData.products') = 'O' + *-- Itereaza prin toate produsele + lnPropCount = AMEMBERS(laProducts, tloJsonData.products, 0) + + ? "Procesare " + TRANSFORM(lnPropCount) + " produse pentru CSV..." + + FOR lnIndex = 1 TO lnPropCount + lcPropName = laProducts(lnIndex) + loProduct = EVALUATE('tloJsonData.products.' + lcPropName) + + IF TYPE('loProduct') = 'O' + *-- Extrage datele produsului + lcCsvRow = ; + IIF(TYPE('loProduct.id')='C', STRTRAN(loProduct.id, ',', ';'), '') + ',' +; + IIF(TYPE('loProduct.sku')='C', STRTRAN(loProduct.sku, ',', ';'), '') + ',' +; + IIF(TYPE('loProduct.name')='C', '"' + STRTRAN(STRTRAN(loProduct.name, '"', '""'), ',', ';') + '"', '') + ',' +; + IIF(TYPE('loProduct.brand')='C', STRTRAN(loProduct.brand, ',', ';'), '') + ',' +; + IIF(TYPE('loProduct.weight')='C', loProduct.weight, IIF(TYPE('loProduct.weight')='N', TRANSFORM(loProduct.weight), '')) + ',' +; + IIF(TYPE('loProduct.stock')='C', loProduct.stock, IIF(TYPE('loProduct.stock')='N', TRANSFORM(loProduct.stock), '')) + ',' +; + IIF(TYPE('loProduct.base_price')='C', loProduct.base_price, IIF(TYPE('loProduct.base_price')='N', TRANSFORM(loProduct.base_price), '')) + ',' +; + IIF(TYPE('loProduct.price')='C', loProduct.price, IIF(TYPE('loProduct.price')='N', TRANSFORM(loProduct.price), '')) + ',' +; + IIF(TYPE('loProduct.vat_included')='C', loProduct.vat_included, IIF(TYPE('loProduct.vat_included')='N', TRANSFORM(loProduct.vat_included), '')) + ',' +; + IIF(TYPE('loProduct.enabled')='C', loProduct.enabled, IIF(TYPE('loProduct.enabled')='N', TRANSFORM(loProduct.enabled), '')) + ',' +; + IIF(TYPE('loProduct.vat')='C', loProduct.vat, IIF(TYPE('loProduct.vat')='N', TRANSFORM(loProduct.vat), '')) + ',' +; + IIF(TYPE('loProduct.currency')='C', loProduct.currency, '') + ',' +; + IIF(TYPE('loProduct.ecotax')='C', loProduct.ecotax, IIF(TYPE('loProduct.ecotax')='N', TRANSFORM(loProduct.ecotax), '')) +; + CHR(13) + CHR(10) + + lcCsvContent = lcCsvContent + lcCsvRow + ENDIF + ENDFOR +ENDIF + +*-- Salvare fisier CSV +STRTOFILE(lcCsvContent, tcCsvFileName) +? "CSV salvat cu " + TRANSFORM(lnPropCount) + " produse" + +ENDPROC + +*-- Functii helper pentru testare (optionale) + +*-- Test conectivitate internet +FUNCTION TestConnectivity +LOCAL loHttp, llResult + +llResult = .T. + +TRY + loHttp = CREATEOBJECT("WinHttp.WinHttpRequest.5.1") + loHttp.Open("GET", "https://www.google.com", .F.) + loHttp.SetTimeouts(5000, 5000, 5000, 5000) + loHttp.Send() + + IF loHttp.Status != 200 + llResult = .F. + ENDIF + +CATCH + llResult = .F. +ENDTRY + +loHttp = NULL +RETURN llResult + +ENDFUNC + +*-- Functie pentru codificare URL +FUNCTION UrlEncode +PARAMETERS tcString + +LOCAL lcResult, lcChar, lnI + +lcResult = "" + +FOR lnI = 1 TO LEN(tcString) + lcChar = SUBSTR(tcString, lnI, 1) + + DO CASE + CASE ISALPHA(lcChar) OR ISDIGIT(lcChar) OR INLIST(lcChar, "-", "_", ".", "~") + lcResult = lcResult + lcChar + OTHERWISE + lcResult = lcResult + "%" + RIGHT("0" + TRANSFORM(ASC(lcChar), "@0"), 2) + ENDCASE +ENDFOR + +RETURN lcResult + +ENDFUNC + +*-- Scriptul cu paginare completa pentru preluarea tuturor produselor +*-- Caracteristici principale: +*-- - Paginare automata pentru toate produsele (100 per pagina) +*-- - Pauze intre cereri pentru respectarea rate limiting +*-- - Creare fisier CSV cu toate produsele +*-- - Salvare fisier JSON complet cu toate datele +*-- - Logging separat pentru fiecare pagina in caz de eroare +*-- - Afisare progres in timpul executiei + +*-- INSTRUCTIUNI DE UTILIZARE: +*-- 1. Modifica lcApiKey cu cheia ta API de la GoMag +*-- 2. Modifica lcApiShop cu URL-ul magazinului tau +*-- 3. Ruleaza scriptul - va prelua automat toate produsele +*-- 4. Verifica fisierele generate: CSV si JSON cu toate produsele + +*-- Script completat cu paginare - verificati fisierele generate \ No newline at end of file diff --git a/nfjson/nfjsoncreate.prg b/nfjson/nfjsoncreate.prg new file mode 100644 index 0000000..ac69ac6 --- /dev/null +++ b/nfjson/nfjsoncreate.prg @@ -0,0 +1,381 @@ +*------------------------------------------------------------------- +* 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 diff --git a/nfjson/nfjsonread.FXP b/nfjson/nfjsonread.FXP new file mode 100644 index 0000000000000000000000000000000000000000..e74ccdc081f2fe19e54688d7749be93aed931e0c GIT binary patch literal 12383 zcmbtb3vg7|dH&D6`_k&Q5&{DTy2u73TL^;jBl2HU_*hi%(pI}rPw8tmg|5fmUUAJsZ~xaq zVF|6f{$4dYXO*g3nDhQR6?S2g7nA0zXfQK8oIM=gna>>!$DC<_S>>7WkZ;~c;o+f? zY}gko9rI#rz_(Bc(5-XcFH@n~0Y|h@@X(sVN_6-b2?Blu{0R8X_%XVcqSpnMkKTTL zUQr@69UyG$qjwd(wQZqbQ%`^b6x*FjbfwbCAa$g6c67$OB75T@O2&ITdgHM~XJS{@r94-fb1?%1qV z9gfYa3dnWV3Wk02M9=gt6qXq|$}|r}pfEcY3fmlELZkdFD-X?D4UpYQd`{uhh))YX zZTK9-r~mDLTYw6jy%xZhfU(eYJ@yWkz5*0~t_t12I2MaBqyQ_0Y%}ktlcyS6+79-s zsSV@~zgMj%cy`R!(s=%OcGHo}@K|=!$noJ}RS9_SsKOdbV-oWfuVR00Rkeli54zGyAp2AXlTl4h#0O^5}}7*^3t4cg`F5Ayo&m9EE>y5f?ItO?K- z+4~-P?)v;X>M$C&dn`B71_c?-4vr6vJRClFG91ol2eU&baKf>pmvCrHl*VGExy>## zfN~+ypoM-p##Qv4rfao07Juy#fB;dH>1-c2`}$T1(gJY0k6T!(_i{7j^>^5lAhC%c**=nkO$I*4S!SZ-W%>&g92H zY#aJy*IBDOiTz5!Px~4Cc26Nv3cjm1(%I1-Zih)|!)f?fP=)b8{<99C5RK+@596SR zv-x~3AHI!^s3vQm3{@9@XjeEh&gk;A1{l(t>>X|riYhQ;-lFEPk)4OWi&Ksx1ZsnH zE(pr5c#2vTBx4%Z6e?kBF{ujDgjHSov8}3)cEgY+l3s0vz0@6hD3Y|OtJ9*$Zj1Ks zSG3lX@r--3oF_rP8!yA>VqlPvB^_-SuE zm5S_&`>3;{E8dlekYBu7VH4|ifJTn6R)?EFh=M}`BihOshJIrG3Q)9(oggT+nNkC` z)Efki8-N#R_jxK^=LyTb6-)hak$xCAKhB9C4#^Lb<%do2L%U&Sw}RV#7zjTY3U+Hf z6|8~_7}mB!+6#r%X!_Y|U=92mux>o{u1zpA@NktF)XcX{C*2a;e3?t zDFZ%jR#`B@F%Pxs5awR1(9C2kEg_?=XgQ0J5mjGtt(*zC381sw z*;n8(=Ai#M#}x?sf^5Kl&AyRyjg0$)cG18P%`|}R68nA5F5JynRhBTWQ8w{?2wEH= z)`Ctf6Wk>gWSP}$$ITOsv$zHGY4x~P2S*%i{x~$Nccg?6ffBFSXr0LP*g6yM*? zL1@>mpzf6*)I+_IWXICtAS_^aJeig?HN|e(EXX?p24-}@qOyT4TGLpfrz_3&wvu9< ziB#M%snQTMs@S}`z$?Vq3fz~~t*&k3#Gur$Iq@Q*(K&C862rh22+T)VCx(IZ1vJp( zlS4kh)=$UtGE4KYl~nuC(d@|B5Ug|V(4(#EGx>bx@h*hCO-EbvxzCQ~##)ZHjtu68 z$C`tiN!@%7reJb&ct`kXD?;bY*wDklTlfTHI}>#$SPO%y066fsgJa`)xcsJ%1lb&9 zaf_-vvDMRTy}rr3Wp(%(`AEdOYvn>DVCFVxbn)v`q4{Lrk@;dcep-Ci4V^98vYbmh^=tSD0i*ob;B`Pp@>QU7 z*JCVlcMHphG_=q6!v)w=tqq*Ra#HjHkh@OoprEKA1*>cd8>19fg;iz%FxTIvM-fCR zy5AUZqzu?bFLbx_0g8tXvU-bY@RFB#-V?W}D-lC5lSuV+b;J_waqya-0%Y2;gu``l zJj@iKW3}Pq?L|Iv9HG;7K9%qqOJ@{`knF-I=r=fR$5O>2LHcLavyl4u>kxk(;jaL*gCQiAW5JH?=9sLEwyi9;0_EnCFwKy8->uU&3B0$F|%hF1U9NENzc|Bl` zD2R;eIS;T@cSv3+!cU?yaA+hyzNs-bYk!`jXJnC19BcB*P14gC_B~^`&IuNa8gOkU z(9(Iqx5T`#IAlPARgc4aSip#f;+=8W;GV8{Dz?g6q~Jnr4=XsM3iVKm$!VwaotH|PSY??82tk%x6 z90@?WOodkVTFa>{(Y-}P`% zHLy+g2b8Zlvj8WC&-{ZFiN@OFJ9jf`Y;C5L6d;)Dc_cl~kajmUpoWh+NNm$_Gh1>KLUTZj5V~kLwHs#d3BOw6suz3U zn>gw>0-!bX9jEtD1P|g1Q*C1hBR2F;2-XPW+N{B9 zBmXmngq27fR@~?tPGs^!%|Xr*I8p_P?0q=_fDX5u(!_Jr4~oUJ*$TOmsVSh^2Kggo zDDJ`?u>Xjsmm{>FL7*oY2*U=1QrP`P*w~egvx#FJf~7d|21n6`;93CFf$x3DBc8NC zy@Yix^~)_O2}oH5ctBCTByqyZDs8W7fCf0F8=Rp?!%2~ZMAU7*r*MQ^CL(*VscCbw z&z`TRf%x9;^nn41hz53cMs^J_TLbhR$j#!~knlrn3)VreP8=CcWsYRIe))^RG)zrH&((%#ku8e#unW2LP@m zCbN!UWq>{s6-a0sn8%3JV~W^cH^Audi1XzEtTl1G1s%kZ!6H+wtmEi&!Y)LOU$1wq zc4%_F?8iOEYS&KHxm~c@?7c#jHrwcL*wE6oqN#Ecsyu}~+^KuXd^d-N12H+32)(l!6X;T+npB zJ{;^g_WI_$FZsoa%DQ-2Q%I0y;RCVaRviA;O)oQt_kogufH5O)t*mtz34;VyMOk55OBAN@ ziIL++4`uWC86JLudGmxY{mK#)5v5L+p}wqCv$IoJ}I8KQQP0Q2>f4in4^mkA4oCz7;T)vz1WE($P~qiWR!9cB?2Xb7mEXNvm{vX#ymt z=ulp}6_5JSMU4-Mt^yS4>WTLz;+-XV>`l^FlrK;>mOV`-8^Fz-S1H18(Tkc(p5xH*_bp590+)`e1W+gXaKxz1RKsjDnYJg22SQFx{-QBqOEg^_a zE&a%s<#asAU`#)J0Mwopob|mV{9qJ}>O%`F$I@+3JmxN2n zL$GFv&}55v3giw}O>%xU4eaS1C|>oq4D9JFX{rjIUIqo%yXwumlxg3oCUYZd3W{L}+R$ z80;s|obAmFyPV`mq{k9LyV&Athf_gD!bJE&)bH?>hj>iXR~VHNs_N(}ZvR6LZO?M< z$WsMjXNUpv<-LT6Wx{sR0X7$Gu`{eHk2-u(G6Vk-H_NY=RIW??j=>W6hry!30$|wTs)#u(o?D@=?La=q#xC8`XLAJ4?Vb=g3uvzsd#!> z`T^po%w#D(KA->VLAYKv&E)?)@pe*?!QANMO^zUN>5z-%Moze=)liJRZ?+ke>%JrM z39n?o9A)DOD!RIaZ|PwdiZaE?mI6b{>jv>+w7=_UKdv$7yyITPmV5&bAjs{^A^uHX zBlq%L^z-DHgz` zAL>X6=ZjM!H=7bAxrdkc>NvxKsv#^D9Iyl@i5H^G&py>C-ThSX1IJ=yVVgbiiU;2_ zdWf~-;{%TTVu0_XTVN;T!iCR*P51_e9P#2<7rVHAY7Pg#kOlU6nblB3%^{7Z!5ML3 zd~c#RUTt0xiRH7I@$8mQ@%xqZ{`)?9R9-Q`MTNA3{GyJzI6UOneF4gh9M7J}WrrWA z(mfLVjSU_j85+zT&bHO)-Vld`V}lvISCtzX&*z2*|E$)T52&Nr{J30v-dd-7D`YP? z&Ewh6FVS5HD~5Ap*$Cf}o?Wf`Ds^At(4z=h27X0%hG?+|`E*#11ZZfC--T%(e__4u zsiH@@4YJd@_VlwGbT249KK6))`eXDlLx2(bWcU9wT?|f7THT~4`Oza&PM8ivow?C} zHjS+mr1Sqx%n~G(cw!dlr;z)^4A6bZi{)h;!c9(!-=-@ypkKm!tT^+Orbe|z9rK)~ zS1Cg0RlRi&P0^3&OZFD)f{NNP=<-?>p)o6?2JQ1oc`u_Cp(p7QR_s$rb%`?SRXiik z!*88BLlHYl?@|Qw{tmOAR_E|^33JbT(yHF`B<1~4ieg`d{tL8~j?uJr8ov{?)tVwp zP2o-33A7lh^Jf9eOO#agDyp8sx+vwXbCkq~+l>2ZddfmSW*t+TtqHZ(K24`F^Ic$| z)M?sm%d_&ii*+QnD=`!a+O{q<+(&l)zj8KZv>b}X@y4PYZnTLk+4c*qe7hV_lXfz_(rl)N}eH z+#M9^!E-=lX=n=S4c^nV8FaD?SxOfGB?@gBRQqH$^M?O;lz$__zZ5ur1$0E!1$xt7oh$p#5b)VjVgJNk_m{rUQF`gDll3XuSaKx}eTm$Dl*|L<26WSFJP9mMEpb z1%`JTI&%)Z(OMP-g$#lBp9X*Q6YI^%8vZ_`wu4i5%O|Q%1A}9NY4Q1P%0mVdw2l6V z{uqDH)7R-Wr)ct!vP zxeQSV6P_?Qf&~O*|)75j}+V576F+=bz&}_$=D(_yk}( z9&91#6%iZz{dk_(NVEs-VYI)A=hwGl4DAWDe}d;{LCW8w{pV;uhv%L55&a15zeM|o zcwV`k=%;9Z8|}OC{M-2a4DIireICz=HoOgv_RDA=!L$E 1 + calledFrom = 'called From '+aerrs(m.stackLevels-1,4)+' line '+Transform(aerrs(m.stackLevels-1,5)) +Else + calledFrom = '' +Endif + +oJson = nfJsonCreate2(cjsonstr,isFileName,reviveCollection) + +Return Iif(Vartype(m.oJson)='O',m.oJson,.Null.) + + +*------------------------------------------------------------------------- +Function nfJsonCreate2(cjsonstr,isFileName,reviveCollection) +*------------------------------------------------------------------------- +* validate parameters: + +Do Case +Case ; + Vartype(m.cjsonstr) # 'C' Or; + Vartype(m.reviveCollection) # 'L' Or ; + Vartype(m.isFileName) # 'L' + + jERROR('invalid parameter type') + +Case m.isFileName And !File(m.cjsonstr) + + jERROR('File "'+Rtrim(Left(m.cjsonstr,255))+'" does not exist') + + +Endcase + +* process json: + +If m.isFileName + cjsonstr = Filetostr(m.cjsonstr) +Endif + + +cJson = Rtrim(Chrtran(m.cjsonstr,Chr(13)+Chr(9)+Chr(10),'')) +pChar = Left(Ltrim(m.cJson),1) + + +nl = Alines(aj,m.cJson,20,'{','}','"',',',':','[',']') + +For xx = 1 To Alen(aj) + If Left(Ltrim(aj(m.xx)),1) $ '{}",:[]' Or Left(Ltrim(m.aj(m.xx)),4) $ 'true/false/null' + aj(m.xx) = Ltrim(aj(m.xx)) + Endif +Endfor + + +Try + + x = 1 + cError = '' + oStack = Createobject('stack') + + oJson = Createobject('empty') + + Do Case + Case aj(1)='{' + x = 1 + oStack.pushObject() + procstring(m.oJson) + + Case aj(1) = '[' + x = 0 + procstring(m.oJson,.T.) + + Otherwise + Error 'Invalid Json: expecting [{ received '+m.pChar + + Endcase + + + If m.reviveCollection + oJson = reviveCollection(m.oJson) + Endif + + +Catch To oerr + + strp = '' + + For Y = 1 To m.x + strp = m.strp+aj(m.y) + Endfor + + Do Case + Case oerr.ErrorNo = 1098 + + cError = ' Invalid Json: '+ m.oerr.Message+crlf+' Parsing: '+Right(m.strp,80) + +*+' program line: '+Transform(oerr.Lineno)+' array item '+Transform(m.x) + + Case oerr.ErrorNo = 2034 + + cError = ' INVALID DATE: '+crlf+' Parsing: '+Right(m.strp,80) + + + Otherwise + + cError = 'program error # '+Transform(m.oerr.ErrorNo)+crlf+m.oerr.Message+' at: '+Transform(oerr.Lineno)+crlf+' Parsing ('+Transform(m.x)+') ' + + Endcase + +Endtry + +If !Empty(m.cError) + jERROR(m.cError) +Endif + +Return m.oJson + + + +*------------------------------------------------ +Procedure jERROR( cMessage ) +*------------------------------------------------ +Error 'nfJson ('+m.calledFrom+'):'+crlf+m.cMessage +Return To nfJsonRead + + + +*-------------------------------------------------------------------------------- +Procedure procstring(obj,eValue) +*-------------------------------------------------------------------------------- +#Define cvalid 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890_' +#Define creem '_______________________________________________________________' + +Private rowpos,colpos,bidim,ncols,arrayName,expecting,arrayLevel,vari +Private expectingPropertyName,expectingValue,objectOpen + +expectingPropertyName = !m.eValue +expectingValue = m.eValue +expecting = Iif(expectingPropertyName,'"}','') +objectOpen = .T. +bidim = .F. +colpos = 0 +rowpos = 0 +arrayLevel = 0 +arrayName = '' +vari = '' +ncols = 0 + +Do While m.objectOpen + + x = m.x+1 + + Do Case + + Case m.x > m.nl + + m.x = m.nl + + If oStack.Count > 0 + Error 'expecting '+m.expecting + Endif + + Return + + Case aj(m.x) = '}' And '}' $ m.expecting + closeObject() + + Case aj(x) = ']' And ']' $ m.expecting + closeArray() + + Case m.expecting = ':' + If aj(m.x) = ':' + expecting = '' + Loop + Else + Error 'expecting : received '+aj(m.x) + Endif + + Case ',' $ m.expecting + + Do Case + Case aj(x) = ',' + expecting = Iif( '[' $ m.expecting , '[' , '' ) + Case Not aj(m.x) $ m.expecting + Error 'expecting '+m.expecting+' received '+aj(m.x) + Otherwise + expecting = Strtran(m.expecting,',','') + Endcase + + + Case m.expectingPropertyName + + If aj(m.x) = '"' + propertyName(m.obj) + Else + Error 'expecting "'+m.expecting+' received '+aj(m.x) + Endif + + + Case m.expectingValue + + If m.expecting == '[' And m.aj(m.x) # '[' + Error 'expecting [ received '+aj(m.x) + Else + procValue(m.obj) + Endif + + + Endcase + + +Enddo + + +*---------------------------------------------------------- +Function anuevoel(obj,arrayName,valasig,bidim,colpos,rowpos) +*---------------------------------------------------------- + + +If m.bidim + + colpos = m.colpos+1 + + If colpos > m.ncols + ncols = m.colpos + Endif + + Dimension obj.&arrayName(m.rowpos,m.ncols) + + obj.&arrayName(m.rowpos,m.colpos) = m.valasig + + If Vartype(m.valasig) = 'O' + procstring(obj.&arrayName(m.rowpos,m.colpos)) + Endif + +Else + + rowpos = m.rowpos+1 + Dimension obj.&arrayName(m.rowpos) + + obj.&arrayName(m.rowpos) = m.valasig + + If Vartype(m.valasig) = 'O' + procstring(obj.&arrayName(m.rowpos)) + Endif + +Endif + + +*----------------------------------------- +Function unescunicode( Value ) +*----------------------------------------- + + +noc=1 + +Do While .T. + + posunicode = At('\u',m.value,m.noc) + + If m.posunicode = 0 + Return + Endif + + If Substr(m.value,m.posunicode-1,1) = '\' And Substr(m.value,m.posunicode-2,1) # '\' + noc=m.noc+1 + Loop + Endif + + nunic = Evaluate('0x'+ Substr(m.value,m.posunicode+2,4) ) + + If Between(m.nunic,0,255) + unicodec = Chr(m.nunic) + Else + unicodec = '&#'+Transform(m.nunic)+';' + Endif + + Value = Stuff(m.value,m.posunicode,6,m.unicodec) + + +Enddo + +*----------------------------------- +Function unescapecontrolc( Value ) +*----------------------------------- + +If At('\', m.value) = 0 + Return +Endif + +* unescape special characters: + +Private aa,elem,unesc + + +Declare aa(1) +=Alines(m.aa,m.value,18,'\\','\b','\f','\n','\r','\t','\"','\/') + +unesc ='' + +#Define sustb 'bnrt/"' +#Define sustr Chr(127)+Chr(10)+Chr(13)+Chr(9)+Chr(47)+Chr(34) + +For Each elem In m.aa + + If ! m.elem == '\\' And Right(m.elem,2) = '\' + elem = Left(m.elem,Len(m.elem)-2)+Chrtran(Right(m.elem,1),sustb,sustr) + Endif + + unesc = m.unesc+m.elem + +Endfor + +Value = m.unesc + +*-------------------------------------------- +Procedure propertyName(obj) +*-------------------------------------------- + +vari='' + +Do While ( Right(m.vari,1) # '"' Or ( Right(m.vari,2) = '\"' And Right(m.vari,3) # '\\"' ) ) And Alen(aj) > m.x + x=m.x+1 + vari = m.vari+aj(m.x) +Enddo + +If Right(m.vari,1) # '"' + Error ' expecting " received '+ Right(Rtrim(m.vari),1) +Endif + +vari = Left(m.vari,Len(m.vari)-1) +vari = Iif(Isalpha(m.vari),'','_')+m.vari +vari = Chrtran( vari, Chrtran( vari, cvalid,'' ) , creem ) + +If vari = 'tabindex' + vari = '_tabindex' +Endif + + +expecting = ':' +expectingValue = .T. +expectingPropertyName = .F. + + +*------------------------------------------------------------- +Procedure procValue(obj) +*------------------------------------------------------------- + +Do Case +Case aj(m.x) = '{' + + oStack.pushObject() + + If m.arrayLevel = 0 + + AddProperty(obj,m.vari,Createobject('empty')) + + procstring(obj.&vari) + expectingPropertyName = .T. + expecting = ',}' + expectingValue = .F. + + Else + + anuevoel(m.obj,m.arrayName,Createobject('empty'),m.bidim,@colpos,@rowpos) + expectingPropertyName = .F. + expecting = ',]' + expectingValue = .T. + + Endif + + +Case aj(x) = '[' + + oStack.pushArray() + + Do Case + + Case m.arrayLevel = 0 + + arrayName = Evl(m.vari,'array') + rowpos = 0 + colpos = 0 + bidim = .F. + +#DEFINE EMPTYARRAYFLAG '_EMPTY_ARRAY_FLAG_' + + Try + AddProperty(obj,(m.arrayName+'(1)'),EMPTYARRAYFLAG) + Catch + m.arrayName = m.arrayName+'_vfpSafe_' + AddProperty(obj,(m.arrayName+'(1)'),EMPTYARRAYFLAG) + Endtry + + + Case m.arrayLevel = 1 And !m.bidim + + rowpos = 1 + colpos = 0 + ncols = 1 + + Dime obj.&arrayName(1,2) + bidim = .T. + + Endcase + + arrayLevel = m.arrayLevel+1 + + vari='' + + expecting = Iif(!m.bidim,'[]{',']') + expectingValue = .T. + expectingPropertyName = .F. + +Otherwise + + isstring = aj(m.x)='"' + x = m.x + Iif(m.isstring,1,0) + + Value = '' + + Do While .T. + + Value = m.value+m.aj(m.x) + + If m.isstring + If Right(m.value,1) = '"' And ( Right(m.value,2) # '\"' Or Right(m.value,3) = '\\' ) + Exit + Endif + Else + If Right(m.value,1) $ '}],' And ( Left(Right(m.value,2),1) # '\' Or Left(Right(Value,3),2) = '\\') + Exit + Endif + Endif + + If m.x < Alen(aj) + x = m.x+1 + Else + Exit + Endif + + Enddo + + closeChar = Right(m.value,1) + + Value = Rtrim(m.value,1,m.closeChar) + + If Empty(Value) And Not ( m.isstring And m.closeChar = '"' ) + Error 'Expecting value received '+m.closeChar + Endif + + Do Case + + Case m.isstring + If m.closeChar # '"' + Error 'expecting " received '+m.closeChar + Endif + + Case oStack.isObject() And Not m.closeChar $ ',}' + Error 'expecting ,} received '+m.closeChar + + Case oStack.isArray() And Not m.closeChar $ ',]' + Error 'expecting ,] received '+m.closeChar + + Endcase + + + + If m.isstring + +* don't change this lines sequence!: + unescunicode(@Value) && 1 + unescapecontrolc(@Value) && 2 + Value = Strtran(m.value,'\\','\') && 3 + +** check for Json Date: + If isJsonDt( m.value ) + Value = jsonDateToDT( m.value ) + Endif + + Else + + Value = Alltrim(m.value) + + Do Case + Case m.value == 'null' + Value = .Null. + Case m.value == 'true' Or m.value == 'false' + Value = Value='true' + Case Empty(Chrtran(m.value,'-1234567890.E','')) And Occurs('.',m.value) <= 1 And Occurs('-',m.value) <= 1 And Occurs('E',m.value)<=1 + If Not 'E' $ m.value + Value = Cast( m.value As N( Len(m.value) , Iif(At('.',m.value)>0,Len(m.value)-At( '.',m.value) ,0) )) + Endif + Otherwise + Error 'expecting "|number|null|true|false| received '+aj(m.x) + Endcase + + + Endif + + + If m.arrayLevel = 0 + + + AddProperty(obj,m.vari,m.value) + + expecting = '}' + expectingValue = .F. + expectingPropertyName = .T. + + Else + + anuevoel(obj,m.arrayName,m.value,m.bidim,@colpos,@rowpos) + expecting = ']' + expectingValue = .T. + expectingPropertyName = .F. + + Endif + + expecting = Iif(m.isstring,',','')+m.expecting + + + Do Case + Case m.closeChar = ']' + closeArray() + Case m.closeChar = '}' + closeObject() + Endcase + +Endcase + + +*------------------------------ +Function closeArray() +*------------------------------ + +If oStack.Pop() # 'A' + Error 'unexpected ] ' +Endif + +If m.arrayLevel = 0 + Error 'unexpected ] ' +Endif + +arrayLevel = m.arrayLevel-1 + +If m.arrayLevel = 0 + + arrayName = '' + rowpos = 0 + colpos = 0 + + expecting = Iif(oStack.isObject(),',}','') + expectingPropertyName = .T. + expectingValue = .F. + +Else + + If m.bidim + rowpos = m.rowpos+1 + colpos = 0 + expecting = ',][' + Else + expecting = ',]' + Endif + + expectingValue = .T. + expectingPropertyName = .F. + +Endif + + + +*------------------------------------- +Procedure closeObject +*------------------------------------- + +If oStack.Pop() # 'O' + Error 'unexpected }' +Endif + +If m.arrayLevel = 0 + expecting = ',}' + expectingValue = .F. + expectingPropertyName = .T. + objectOpen = .F. +Else + expecting = ',]' + expectingValue = .T. + expectingPropertyName = .F. +Endif + + +*---------------------------------------------- +Function reviveCollection( o ) +*---------------------------------------------- + +Private All + +oConv = Createobject('empty') + +nProp = Amembers(elem,m.o,0,'U') + +For x = 1 To m.nProp + + estaVar = m.elem(x) + + esArray = .F. + esColeccion = Type('m.o.'+m.estaVar) = 'O' And Right( m.estaVar , 14 ) $ '_KV_COLLECTION,_KL_COLLECTION' And Type( 'm.o.'+m.estaVar+'.collectionitems',1) = 'A' + + Do Case + Case m.esColeccion + + estaProp = Createobject('collection') + + tv = m.o.&estaVar + + m.keyValColl = Right( m.estaVar , 14 ) = '_KV_COLLECTION' + + For T = 1 To Alen(m.tv.collectionItems) + + If m.keyValColl + esteval = m.tv.collectionItems(m.T).Value + Else + esteval = m.tv.collectionItems(m.T) + ENDIF + + IF VARTYPE(m.esteval) = 'C' AND m.esteval = emptyarrayflag + loop + ENDIF + + If Vartype(m.esteval) = 'O' Or Type('esteVal',1) = 'A' + esteval = reviveCollection(m.esteval) + Endif + + If m.keyValColl + estaProp.Add(esteval,m.tv.collectionItems(m.T).Key) + Else + estaProp.Add(m.esteval) + Endif + + Endfor + + Case Type('m.o.'+m.estaVar,1) = 'A' + + esArray = .T. + + For T = 1 To Alen(m.o.&estaVar) + + Dimension &estaVar(m.T) + + If Type('m.o.&estaVar(m.T)') = 'O' + &estaVar(m.T) = reviveCollection(m.o.&estaVar(m.T)) + Else + &estaVar(m.T) = m.o.&estaVar(m.T) + Endif + + Endfor + + Case Type('m.o.'+estaVar) = 'O' + estaProp = reviveCollection(m.o.&estaVar) + + Otherwise + estaProp = m.o.&estaVar + + Endcase + + + estaVar = Strtran( m.estaVar,'_KV_COLLECTION', '' ) + estaVar = Strtran( m.estaVar, '_KL_COLLECTION', '' ) + + Do Case + Case m.esColeccion + AddProperty(m.oConv,m.estaVar,m.estaProp) + Case m.esArray + AddProperty(m.oConv,m.estaVar+'(1)') + Acopy(&estaVar,m.oConv.&estaVar) + Otherwise + AddProperty(m.oConv,m.estaVar,m.estaProp) + Endcase + +Endfor + +Try + retCollection = m.oConv.Collection.BaseClass = 'Collection' +Catch + retCollection = .F. +Endtry + +If m.retCollection + Return m.oConv.Collection +Else + Return m.oConv +Endif + + +*---------------------------------- +Function isJsonDt( cstr ) +*---------------------------------- +Return Iif( Len(m.cstr) = 19 ; + AND Len(Chrtran(m.cstr,'01234567890:T-','')) = 0 ; + and Substr(m.cstr,5,1) = '-' ; + and Substr(m.cstr,8,1) = '-' ; + and Substr(m.cstr,11,1) = 'T' ; + and Substr(m.cstr,14,1) = ':' ; + and Substr(m.cstr,17,1) = ':' ; + and Occurs('T',m.cstr) = 1 ; + and Occurs('-',m.cstr) = 2 ; + and Occurs(':',m.cstr) = 2 ,.T.,.F. ) + + +*----------------------------------- +Procedure jsonDateToDT( cJsonDate ) +*----------------------------------- +Return Eval("{^"+m.cJsonDate+"}") + + + +****************************************** +Define Class Stack As Collection +****************************************** + +*--------------------------- + Function pushObject() +*--------------------------- + This.Add('O') + +*--------------------------- + Function pushArray() +*--------------------------- + This.Add('A') + +*-------------------------------------- + Function isObject() +*-------------------------------------- + If This.Count > 0 + Return This.Item( This.Count ) = 'O' + Else + Return .F. + Endif + + +*-------------------------------------- + Function isArray() +*-------------------------------------- + If This.Count > 0 + Return This.Item( This.Count ) = 'A' + Else + Return .F. + Endif + +*---------------------------- + Function Pop() +*---------------------------- + cret = This.Item( This.Count ) + This.Remove( This.Count ) + Return m.cret + +****************************************** +Enddefine +****************************************** + +