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 0000000..e74ccdc Binary files /dev/null and b/nfjson/nfjsonread.FXP differ diff --git a/nfjson/nfjsonread.prg b/nfjson/nfjsonread.prg new file mode 100644 index 0000000..671f3e6 --- /dev/null +++ b/nfjson/nfjsonread.prg @@ -0,0 +1,775 @@ +*------------------------------------------------------------------- +* Created by Marco Plaza vfp2nofox@gmail.com / @vfp2Nofox +* ver 2.000 - 26/03/2016 +* ver 2.090 - 22/07/2016 : +* improved error management +* nfjsonread will return .null. for invalid json +*------------------------------------------------------------------- +Lparameters cjsonstr,isFileName,reviveCollection + +#Define crlf Chr(13)+Chr(10) + +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 + +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 +****************************************** + +