*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
* nastavi cesty k westwindovym adresarum, vytvori objekt oHTTP, pp_HTTP a loSerializer
*
* procedure HTTP_GET (url_end) posila request GET s pouzitim objectu oHTTP
*
* procedure HTTP_REQUEST (url_end, sloveso, json_string) posila request s telem
*
* funkce JSON_OK vrati .T., pokud "retval" obsahuje "200" a "OK"
* 
* funkce JSON_ROWCOUNT (json) vrati pocet recordu
* 
* funkce STRIP_WHITESPACES da pred carku a "}" se da tabulator, ktery se v dalsim parsovani uziva jako ukoncovac itemu
*
* funkce SLOZ_RESPONSE_STRING prida k json ze serveru resultcode a cislo chyby, vse do formatu json
*
* funkce GET_INTEGER_ITEM  vraci item typu integer nebo nulu pri nenalezeni
*
* funkce GET_NUM_ITEM  vraci ciselny item nebo null pri nenalezeni
*
* funkce GET_OBJECT_ITEM  vraci objektovy item bez ohranicujicich curlybraces, nebo null pri nenalezeni
*
* funkce GET_ARRAY_ITEM   vraci objektovy item bez ohranicujicich hranatych zavorek, nebo null pri nenalezeni
*
* funkce D_TO_S   formatuje datum do stringu YYYY-MM-DD
*
* funkce FLOAT2QUOTED_STRING (cislo, desetin) formatuje float do stringu v uvozovkach
*
* funkce STR2URI (pcString)      koduje string do URI
*
*
*  2016-02-23 - pokud existuje neprazdna promenna m.http_logovat, jsou requesty i odpovedi logovany do (m.gccen_path + "zu_httpRRMM.txt")
*  2017-09-11 - pokud neexistuje m.gchom_path, loguje se do aktualniho adresare (".\zu_httpRRMM.txt")
*  2017-09-13 - pridana autentifikace, kterou neni treba explicitne volat, procedury ji zavolaji samy, pokud dostanou odpoved 403
*             - nechany pouze 2 komunikacni procedury - HTTP_GET
*             -                                       - HTTP_REQUEST, jejimz parametrem je i HttpVerb a obsluhuje vsechnu komunikaci s parametry v tele
*             -
*
*  2017-11-16 - JQ pridelan parametr na jmeno:heslo
*
*  2022-03-16 - v souvislosti s GOOS Globus upraveno ziskavani tokenu, http_auth_globus
*			  - zavedena promenna http_auth_typ. Pokud je Globus, pouziva se Bearer misto Token
*			  - logovani doby trvani prikazu
*			  - zavedena promenna http_token_id, bud "Bearer " nebo "Token ". Nektere datastory nepodporuji Bearer
*
*  2023-01-30 - pridana od Evzi fce GET_OBJECT_ITEM
*
*  2023-03-06 - get_string_item bere i null hodnoty
*
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  

PARAMETERS address, cJmenoHeslo

#DEFINE CRLF CHR(13)+CHR(10)
IF EMPTY(m.address)
    TRY
       address = ALLTRIM(FILETOSTR( m.gchom_path + "datastore_address.txt" ))
    CATCH
*       address = "http://datastore.alto.mine.nu/"
       address = "http://datastore-rezervace.alto.mine.nu/"
*       address = "http://10.143.195.172:8888/"                      && vnitrni adresa v Makru
    ENDTRY
ENDIF
address = m.address + IIF(RIGHT(m.address, 1)="/", "", "/")

PUBLIC http_username, http_pwd
IF EMPTY(cJmenoHeslo)
	http_username = "admin"
	http_pwd = "admin"
ELSE
	TRY
		http_username = LEFT(m.cJmenoHeslo, AT(':', cJmenoHeslo)-1)
		http_pwd      = ALLTRIM(SUBSTR(m.cJmenoHeslo, AT(':', cJmenoHeslo)+1))
	CATCH
		http_username = "admin"
		http_pwd = "admin"
	ENDTRY  
ENDIF 

CLEAR 
SET EXACT OFF

IF VARTYPE(http_path) = "U"
    PUBLIC http_path
ENDIF
http_path = LOWER(JUSTPATH(sys(16))) + "\"

SET PATH TO (http_path)                       ADDITIVE
SET PATH TO (http_path + "west-wind")         ADDITIVE 
SET PATH TO (http_path + "west-wind\classes") ADDITIVE 

SET PROCEDURE TO (SYS(16))                    ADDITIVE 

IF VARTYPE(http_adresa) = "U"
    PUBLIC http_adresa
ENDIF
http_adresa = m.address

IF VARTYPE(http_auth_token) = "U"
    PUBLIC http_auth_token
ENDIF

IF VARTYPE(http_auth_typ) = "U"
	PUBLIC http_auth_typ
	http_auth_typ = ""
ENDIF 

IF VARTYPE(machine) = "U"
	PUBLIC machine
	m.machine = "Muj Komp"
ENDIF 

IF VARTYPE(http_token_id) = "U"
	PUBLIC http_token_id
	http_token_id = "Bearer "
ENDIF 

DO wwHTTP

IF UPPER(http_auth_typ) = "GLOBUS"
	auth_json = http_auth_globus()
ENDIF 

*DO vytvor_objekty_http    && objekty wwHttp se vytvori zde a existuji po celou dobu behu programu, jinak se tvori pri kazdem volani http_get/put/delete

*? "- - -  " + TTOC(datetime()) + "  WestWind initialized to " + m.http_adresa + "  - - -"


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_get (url_end)
request_string = m.http_adresa + url_end

IF VARTYPE(get_HTTP) # "O"           && pokud objekt neexistuje, je vytvoren a nastaven
    get_HTTP = CREATEOBJECT("wwHttp")
    DO set_http_parms WITH get_HTTP, "GET"
ENDIF

*!*	* JQ
*!*	IF VARTYPE(http_auth_token) = "C" .and. LEN(m.http_auth_token)  <= 11
*!*	    auth_json = http_auth()
*!*	ENDIF
*!*	*JQ

IF VARTYPE(http_auth_token) = "C" .and. LEN(m.http_auth_token) > 11
    get_HTTP.AddHeader('Authorization', http_token_id + m.http_auth_token)
ENDIF 
http_zacatek_prace = SECONDS()
retval_string = sloz_response_string ( get_HTTP.HttpGet(m.request_string), get_HTTP.cResultCode, get_HTTP.cResultCodeMessage, get_HTTP.nError, get_HTTP.cErrorMSg )
DO http_log WITH m.retval_string, "GET " + m.url_end + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" 

IF "403" $ get_string_item (m.retval_string, "http_status")
    auth_json = http_auth()
    *? "AUTH:", m.auth_json
    IF .not. ("403" $ get_string_item (m.auth_json, "http_status"))
        IF .not. EMPTY(m.http_auth_token)
            get_HTTP.AddHeader('Authorization', http_token_id + m.http_auth_token)
        ENDIF 
        retval_string = sloz_response_string ( get_HTTP.HttpGet(m.request_string), get_HTTP.cResultCode, get_HTTP.cResultCodeMessage, get_HTTP.nError, get_HTTP.cErrorMSg )
        DO http_log WITH m.retval_string, "GET " + m.url_end + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" 
    ENDIF 
ENDIF 

get_HTTP.httpclose()
RETURN m.retval_string 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_request (url_end, sloveso, body_string)     && PUT POST PATCH DELETE
request_string = m.http_adresa + m.url_end

IF VARTYPE(pp_HTTP) # "O"           && pokud objekt neexistuje, je vytvoren a nastaven
    pp_HTTP = CREATEOBJECT("wwHttp")
    DO set_http_parms WITH pp_HTTP, "PUT"
ENDIF

IF VARTYPE(http_auth_token) = "C" .and. LEN(m.http_auth_token) > 11
    pp_HTTP.AddHeader('Authorization', http_token_id + m.http_auth_token)
ENDIF 

IF VARTYPE(body_string) = "C" .and. LEN(m.body_string) > 0
    pp_HTTP.AddPostKey()    && to reset post buffer
    pp_HTTP.AddPostKey(strconv(strconv(body_string,1),9))   && do UTF-8
ELSE
    body_string = ""
ENDIF 

pp_HTTP.cHttpVerb = m.sloveso
http_zacatek_prace = SECONDS()
retval_string = sloz_response_string ( pp_HTTP.HttpGet(m.request_string), pp_HTTP.cResultCode, pp_HTTP.cResultCodeMessage, pp_HTTP.nError, pp_HTTP.cErrorMSg )
DO http_log WITH m.retval_string, m.sloveso + " " + m.request_string + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" + IIF(EMPTY(m.body_string), "", CRLF + "         BODY>>> " + m.body_string + " <<<BODY ")

IF "403" $ get_string_item (m.retval_string, "http_status")
    auth_json = http_auth()
    *? "AUTH:", m.auth_json
    IF .not. ("403" $ get_string_item (m.auth_json, "http_status"))

        IF VARTYPE(http_auth_token) = "C" .and. LEN(m.http_auth_token) > 11
            pp_HTTP.AddHeader('Authorization', http_token_id + m.http_auth_token)
        ENDIF 
        pp_HTTP.cHttpVerb = m.sloveso
        IF VARTYPE(body_string) = "C" .and. LEN(m.body_string) > 0
            pp_HTTP.AddPostKey()    && to reset post buffer
            pp_HTTP.AddPostKey(strconv(strconv(body_string,1),9))   && do UTF-8
        ELSE
            body_string = ""
        ENDIF 

        retval_string = sloz_response_string ( pp_HTTP.HttpGet(m.request_string), pp_HTTP.cResultCode, pp_HTTP.cResultCodeMessage, pp_HTTP.nError, pp_HTTP.cErrorMSg )
        DO http_log WITH m.retval_string, m.sloveso + " " + m.request_string + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" + IIF(EMPTY(m.body_string), "", CRLF + "         BODY>>> " + m.body_string + " <<<BODY ")
    ENDIF 

ENDIF 

pp_HTTP.httpclose()
RETURN m.retval_string 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_auth 
IF UPPER(http_auth_typ) = "GLOBUS"
	m.auth_retval_string  = http_auth_globus()
ELSE 
	auth_request_string = m.http_adresa + IIF(http_token_id == "Token ", "auth/get_token", "auth/v2/get_token")
	auth_body_string = '{"username": "' + m.http_username+ '", "password": "' + m.http_pwd + '" }'

	auth_HTTP=CREATEOBJECT("wwHttp")
	DO set_http_parms WITH auth_HTTP, "PUT"
	auth_HTTP.AddPostKey()    && to reset post buffer
	auth_HTTP.AddPostKey(strconv(strconv(auth_body_string,1),9))   && do UTF-8
	auth_HTTP.cHttpVerb = "POST"

	auth_retval_string = sloz_response_string ( auth_HTTP.HttpGet(m.auth_request_string), auth_HTTP.cResultCode, auth_HTTP.cResultCodeMessage, auth_HTTP.nError, auth_HTTP.cErrorMSg )

	DO http_log WITH m.auth_retval_string, "AUTH " + m.http_adresa + CRLF + chr(9) + retez_programu() + " from " + UPPER(m.machine)
	auth_HTTP.httpclose()

	IF json_ok(m.auth_retval_string)
	    http_auth_token = get_string_item (m.auth_retval_string, IIF(http_token_id == "Token ", "token", "access_token"))
	    IF VARTYPE(m.http_auth_token) # "C"
	            http_auth_token = "-- DENIED --"
	    ENDIF 
	ELSE
	    http_auth_token = ""
	ENDIF 
ENDIF 
RETURN m.auth_retval_string 


PROCEDURE http_auth_globus

auth_request_string = "https://gsoat.globus.cz/connect/token"
auth_HTTP=CREATEOBJECT("wwHttp")
DO set_http_parms WITH auth_HTTP, "AUTH"

auth_HTTP.AddPostKey()    && to reset post buffer
auth_HTTP.AddPostKey("grant_type"   , "client_credentials"       )
auth_HTTP.AddPostKey("client_secret", m.http_pwd     		     )
auth_HTTP.AddPostKey("client_id"    , m.http_username            )
auth_HTTP.AddPostKey("scope"        , "apiFoodPickupCashRegister")

*auth_retval_string = sloz_response_string ( auth_HTTP.Post(m.auth_request_string), pp_HTTP.cResultCode, pp_HTTP.cResultCodeMessage, pp_HTTP.nError, pp_HTTP.cErrorMSg )


auth_HTTP.cHttpVerb = "POST"

auth_retval_string = sloz_response_string ( auth_HTTP.HttpGet(m.auth_request_string), auth_HTTP.cResultCode, auth_HTTP.cResultCodeMessage, auth_HTTP.nError, auth_HTTP.cErrorMSg )

DO http_log WITH m.auth_retval_string, "AUTH " + m.http_adresa + CRLF + chr(9) + retez_programu() + " from " + UPPER(m.machine)
auth_HTTP.httpclose()

http_auth_token = "-DENIED-"
IF json_ok(m.auth_retval_string)
    http_auth_token = get_string_item (m.auth_retval_string, "access_token")
    IF VARTYPE(m.http_auth_token) = "C"
        *http_auth_token = "Bearer " + m.http_auth_token 
    ENDIF 
ENDIF 
RETURN m.auth_retval_string 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE vytvor_objekty_http
   IF VARTYPE(get_HTTP) = "U"           && objekt pro cteci routy (GET)
       PUBLIC get_HTTP
   ENDIF
   get_HTTP=CREATEOBJECT("wwHttp")
   DO set_http_parms WITH get_HTTP, "GET"

   IF VARTYPE(del_HTTP) = "U"           && objekt pro deletovaci routy (DELETE)
       PUBLIC del_HTTP
   ENDIF
   del_HTTP=CREATEOBJECT("wwHttp")
   DO set_http_parms WITH del_HTTP, "GET"

   IF VARTYPE(pp_HTTP) = "U"        && objekt pro zapisovaci routy (PUT, POST)
       PUBLIC pp_HTTP
   ENDIF
   pp_HTTP = CREATEOBJECT("wwHttp")
   DO set_http_parms WITH pp_HTTP, "PUT"


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE set_http_parms_puv
PARAMETERS http_object, typ_objectu

http_object.nconnecttimeout = 6
http_object.cUserAgent = "Alto-WW"
http_object.lIgnoreCertificateWarnings = .T.
http_object.cpassword = "1alto2alta"
http_object.cusername = "alto"

IF m.typ_objectu = "PUT"
    http_object.nHttpPostMode = 8
    http_object.cContentType = "application/json; charset=UTF-8"
ENDIF 

PROCEDURE set_http_parms
PARAMETERS http_object, typ_objectu

http_object.nHttpServiceFlags = BITOR( 0x00400000, 0x00002000, 0x00001000 )  && keep connection + ignore cert
http_object.nconnecttimeout = 6
http_object.cUserAgent = "Alto-WW"
http_object.lIgnoreCertificateWarnings = .T.
*http_object.cpassword = "1alto2alta"
*http_object.cusername = "alto"

DO CASE
CASE m.typ_objectu = "PUT"
    http_object.cContentType = "application/json; charset=UTF-8"   
*    http_object.cContentType = "Content-type: application/x-www-form-urlencoded"
*    http_object.nHttpPostMode = 2

CASE m.typ_objectu = "AUTH"
    http_object.nHttpPostMode = 2

OTHERWISE

ENDCASE

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION sloz_response_string (response, ResultCode, ResultMsg, ErrNo, ErrMsg)
http_response = STRCONV(STRCONV(m.response, 11),2)
status_string = ' "http_status":"' + ResultCode + " " + ResultMsg + '", '
IF Errno # 0
   status_string = m.status_string + '"http_error":"'  + ALLTRIM(STR(ErrNo)) + ErrMSg + '", '
ENDIF
zacatek_json = AT("{", m.http_response)
IF BETWEEN(m.zacatek_json, 1, 11)
    RETURN LEFT(m.http_response, m.zacatek_json) + m.status_string + SUBSTR(m.http_response, m.zacatek_json+1)
ELSE
    RETURN '{' + m.status_string + '}'
ENDIF 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
*     hleda v parametru retezec za "http_status" hodnotu "200" a "OK"
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION json_ok (json)
PRIVATE retstatus
retstatus = get_string_item (m.json, "http_status")
retval = LEFT(SUBSTR(json, ATC('"http_status":', m.json)+14), 22)
*RETURN ("200" $ m.retval .and. "OK" $ m.retval)
RETURN (LEFT(retstatus,1)='2')


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
*      hleda v parametru hodnotu (cislo) za "count"
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION json_rowcount (json)
pozice = ATC('"count":', m.json)
IF m.pozice > 0
    retval = ALLTRIM(LEFT(SUBSTR(json, m.pozice+8), 22))
    RETURN INT(VAL(m.retval))
ELSE
    RETURN -1
ENDIF 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION get_integer_item (json, item, poradi)
IF EMPTY(m.poradi)
    poradi = 1
ENDIF 
LOCAL at_item, texticek
at_item = ATC('"' + m.item + '":', m.json, m.poradi)
IF m.at_item > 0
   texticek = LEFT(SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3), 33)
   RETURN INT(VAL(m.texticek))
ELSE
   RETURN 0
ENDIF 

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION get_num_item (json, item, poradi)
IF EMPTY(m.poradi)
    poradi = 1
ENDIF 
LOCAL at_item, o_set_point, textcislo, texticek, ii, retval
at_item = ATC('"' + m.item + '":', m.json, m.poradi)
IF m.at_item > 0
   o_set_point = SET("POINT")
   SET POINT TO "."
   texticek = SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3)
   textcislo = ""
   FOR ii = 1 TO LEN(m.texticek)
      pismenko = SUBSTR(m.texticek, m.ii, 1)
      IF m.pismenko $ ",]}"
          EXIT 
      ELSE 
          textcislo = m.textcislo + m.pismenko
      ENDIF 
   ENDFOR 
   retval = VAL(m.textcislo)
   SET POINT TO (m.o_set_point)
   RETURN m.retval
ELSE
   RETURN .null.
ENDIF 

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION get_string_item (json, item, poradi)
IF EMPTY(m.poradi)
    poradi = 1
ENDIF 
LOCAL at_item, o_set_point, textcislo, texticek, ii, retval
at_item = ATC('"' + m.item + '":', m.json, m.poradi)
IF m.at_item > 0
   texticek = SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3)
   IF LEFT(ALLTRIM(texticek), 4) != "null"
	   at_quote1 = AT('"', m.texticek, 1)
	   at_quote2 = AT('"', m.texticek, 2)
	   IF m.at_quote2 > 0
	       retval = SUBSTR(m.texticek, m.at_quote1 + 1, m.at_quote2 - m.at_quote1-1)
	       RETURN m.retval
	   ELSE 
	       RETURN .null.
	   ENDIF
   ELSE
   		RETURN .null.
   ENDIF  
ELSE
   RETURN .null.
ENDIF 

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION get_array_item (json, item, poradi)
IF EMPTY(m.poradi)
    poradi = 1
ENDIF 
LOCAL at_item, o_set_point, textcislo, texticek, ii, retval
at_item = ATC('"' + m.item + '":', m.json, m.poradi)
IF m.at_item > 0
    texticek = ALLTRIM(SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3))
    IF ATC("null", LEFT(texticek, 6)) = 0
        at_quote1 = AT('[', m.texticek, 1)
        IF at_quote1 > 0
            texticek = SUBSTR(m.texticek, m.at_quote1 + 1)
            text_obj = ""
            vnoreni = 1
            FOR ii = 1 TO LEN(m.texticek)
               pismenko = SUBSTR(m.texticek, m.ii, 1)
               DO CASE 
               CASE pismenko = "["
                   vnoreni = m.vnoreni + 1
                   text_obj = m.text_obj + m.pismenko
               CASE pismenko = "]"
                   vnoreni = m.vnoreni - 1
                   IF m.vnoreni = 0
                       EXIT 
                   ENDIF 
                   text_obj = m.text_obj + m.pismenko
               OTHERWISE 
                   text_obj = m.text_obj + m.pismenko
               ENDCASE 
            ENDFOR 
            RETURN m.text_obj
        ENDIF 
    ENDIF 
ENDIF 
RETURN .null.

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION get_object_item (json, item, poradi)
IF EMPTY(m.poradi)
    poradi = 1
ENDIF 
LOCAL at_item, o_set_point, textcislo, texticek, ii, retval
at_item = ATC('"' + m.item + '":', m.json, m.poradi)
IF m.at_item > 0
    texticek = ALLTRIM(SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3))
    IF ATC("null", LEFT(texticek, 6)) = 0
        at_quote1 = AT('{', m.texticek, 1)
        IF at_quote1 > 0
            texticek = SUBSTR(m.texticek, m.at_quote1 + 1)
            text_obj = ""
            vnoreni = 1
            FOR ii = 1 TO LEN(m.texticek)
               pismenko = SUBSTR(m.texticek, m.ii, 1)
               DO CASE 
               CASE pismenko = "{"
                   vnoreni = m.vnoreni + 1
                   text_obj = m.text_obj + m.pismenko
               CASE pismenko = "}"
                   vnoreni = m.vnoreni - 1
                   IF m.vnoreni = 0
                       EXIT 
                   ENDIF 
                   text_obj = m.text_obj + m.pismenko
               OTHERWISE 
                   text_obj = m.text_obj + m.pismenko
               ENDCASE 
            ENDFOR 
            RETURN "{" + m.text_obj + "}"
        ENDIF 
    ENDIF 
ENDIF 
RETURN .null.

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE tiskni_http_response (odpoved)
predposledni = "QWE"
delka_radku = 0
FOR ii = 1 TO LEN(m.odpoved)
   pismenko = SUBSTR(m.odpoved, ii, 1)
   IF (pismenko # CHR(10)) .and. (pismenko # CHR(13))
       IF (pismenko = "{")  .or.  (m.pismenko = '"' .and. predposledni = ',' .and. m.delka_radku > 133)  .or.  (m.delka_radku > 155)
          ?? CHR(13)+CHR(10)
          delka_radku = 0
       ELSE
          delka_radku = delka_radku + 1
       ENDIF
       ?? m.pismenko
       predposledni = m.pismenko
   ENDIF
ENDFOR 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
*    pred carku a "}" se da tabulator, ktery se v dalsim parsovani uziva jako ukoncovac itemu
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION strip_whitespaces (json_txt)
LOCAL json, znak, ii
json = ""
uvnitr_stringu = .F.
FOR ii = 1 TO LEN(m.json_txt)
   znak = SUBSTR(m.json_txt, m.ii, 1)
   DO CASE 
   CASE m.znak = '"'
      uvnitr_stringu = .not. uvnitr_stringu
      json = m.json + m.znak

   CASE m.uvnitr_stringu
      IF m.znak = CHR(9)
         json = m.json + " "
      ELSE
         json = m.json + m.znak
      ENDIF 

   OTHERWISE     && vne stringu
      DO CASE 
      CASE m.znak = ','
        json = m.json + CHR(9) + m.znak
      CASE m.znak = '}'
        json = m.json + CHR(9) + m.znak
      CASE m.znak > ' '
        json = m.json + m.znak
      ENDCASE 
   ENDCASE 
ENDFOR 
RETURN m.json


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION d_to_s
LPARAMETERS datum
pom_d = DTOS(m.datum)
RETURN LEFT(m.pom_d, 4) + "-" + SUBSTR(m.pom_d, 5,2) + "-" + SUBSTR(m.pom_d, 7,2)


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION float2quoted_string (cislo, desetin)
IF EMPTY(m.desetin)
    desetin = 2
ENDIF 
RETURN  '"' + STRTRAN( ALLTRIM(STR(m.cislo, 12, m.desetin)), ",", "." ) + '"'


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION str2uri (pcString)
LOCAL i, bajt, ret, retez, pismenko
ret = ""
retez = "0123456789ABCDEF"
pcString = ALLTRIM(m.pcString)

FOR i = 1 TO LEN(pcString)
    pismenko = SUBSTR(pcString,i,1)
    DO CASE
    CASE BETWEEN(m.pismenko, "0", "9")
        ret = m.ret + m.pismenko
    CASE BETWEEN(m.pismenko, "a", "z")
        ret = m.ret + m.pismenko
    CASE BETWEEN(m.pismenko, "A", "Z")
        ret = m.ret + m.pismenko
    OTHERWISE
        bajt = ASC(m.pismenko)
        ret = m.ret + "%" + ;
            SUBSTR(m.retez,INT(bajt/16)+1,1) + ;
            SUBSTR(m.retez,MOD(bajt,16)+1,1)
    ENDCASE
ENDFOR
RETURN ret


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_log
LPARAMETERS text_do_logu, poznamecka

IF VARTYPE(http_logovat) # "U"
    IF .not. EMPTY(m.http_logovat)
        jmeno_logu = IIF( VARTYPE(m.zur_path) = "C", m.zur_path, ".\") + "zu_http" + SUBST(DTOS(DATE()), 3, 4) + ".txt"

        log_prefix = CRLF + REPLICATE("    *", 22) + CRLF + LEFT(TTOC(DATETIME(), 3), 16) + "  " + IIF(VARTYPE(poznamecka)="C", m.poznamecka, "")
        STRTOFILE( log_prefix + CRLF + m.text_do_logu + CRLF, m.jmeno_logu, 1 )
    ENDIF 
ENDIF 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE oznam_hotovo
? CRLF + CRLF + PADC("   HOTOVO   ", 99, "=") + CRLF
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  

FUNCTION retez_programu
retez_prg = "    " + program(3) + " " + program(4) + " " + program(5) + " " + program(6) + " " + program(7) + " " + program(8)
pozice_vlastniho_jmena = ATC(" retez_programu", m.retez_prg)
IF m.pozice_vlastniho_jmena > 11    && vynecha se i nazev predchoziho programu, protoze to muze byt ppgm_http nebo http_auth
    retez_prg = LEFT(m.retez_prg, m.pozice_vlastniho_jmena - 11) 
ENDIF 
RETURN m.retez_prg

