*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
* 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 "20" 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_BOOLEAN_ITEM vraci item typu boolean nebo null pri nenalezeni
* funkce GET_NUM_ITEM     vraci ciselny item nebo null pri nenalezeni
* funkce GET_STRING_ITEM  vraci stringovy 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
*
*
*  2017-09-13 - pridana autentifikace, kterou neni treba explicitne volat, procedury ji zavolaji samy, pokud dostanou odpoved 403
*  2018-06-16 - pokud M.HTTP_LOGOVAT neexistuje, take se loguje (cili existujici .and. empt() je jedina situace k NElogovani) do (m.gccen_path + "zu_httpRRMM.txt") nebo do .\
*  2018-09-16 - adresa muze byt zadana ve formatu http(s)://username:password@domainname, program si z toho jednotlive komponenty vytaha
*  2018-10-15 - do logu se zapisuje nastavena adresa datastore, jmeno volajiciho programu i doba obsluhy requestu
*  2018-11-13 - pokud delka logu prekroci nastavenou hranici, soubory se tvori denne, nikoli mesicne
*  2019-01-03 - pokud M.HTTP_READ_ONLY_MODE neexistuje nebo je EMPTY(), posila zapisove requesty normalne, jinak se posila pouze GET
*  2019-01-15 - opraveno vyhodnoceni null v get_num_item
*  2020-08-18 - AUTH zapisuje do logu adresu
*  2020-09-04 - nova autentifikace
*  2022-02-22 - omezena velikost zurnalu, kdyz jsou moc velke, generuji se misto mesice 1 denne nebo 1 hodinove
*  2022-03-11 - set_http_parms pro parametr "AUTH" nastavuje potrebne pro auth globus
*             - path na west-wind se pridava jen pokud uz neni
*             - objekty http se tvori vzdy v prislusnych komunikacnich procedurach
*  2022-03-22 - hned pri inicializaci se vola autentifikacni routa
*  2022-08-02 - requesty jsou v logu cislovany
*  2022-10-31 - je vytvoren adresar pro logy, pokud neexistuje
*  2022-12-05 - kdyz volano bez parametru, adresa datastoru se primarne bere z promenne DATASTORE_ADD
*  2023-07-25 - http_log pro masinu evzen pridava ke vsem { jeste CRLF
*
*
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  

PARAMETERS dlouhy_string, auth_string

#DEFINE CRLF CHR(13)+CHR(10)

DO publikuj WITH "http_adresa", ""
DO publikuj WITH "http_auth_body_string", ""
DO publikuj WITH "http_path", ""
DO publikuj WITH "http_auth_token", ""
DO publikuj WITH "http_jmeno_logu", ""
DO publikuj WITH "http_jmeno_ppgm", JUSTSTEM(SYS(16))
DO publikuj WITH "http_poradi_requestu", 0

IF EMPTY(m.dlouhy_string)
    IF VARTYPE(datastore_add) = "C" .and. LEN(m.datastore_add) > 11
        cely_string = m.datastore_add
    ELSE 
        TRY
           cely_string = ALLTRIM(FILETOSTR( m.gchom_path + "datastore_address.txt" ))
        CATCH
           cely_string = "--neni--" 
        ENDTRY
    ENDIF 
ELSE 
    cely_string = m.dlouhy_string
ENDIF
DO parsuj_adresu_a_credentials && naplni http_adresa a auth_string 

IF EMPTY(m.auth_string)
    http_auth_body_string = '{"username": "admin", "password": "admin" }'
ELSE
    http_auth_body_string = m.auth_string
ENDIF 

CLEAR 
SET EXACT OFF

http_path = UPPER(JUSTPATH(sys(16)))
SET PATH TO (http_path) ADDITIVE
pridej_path()

SET PROCEDURE TO (SYS(16)) ADDITIVE 
DO wwHTTP

nastav_jmeno_logu()

? "- - -  " + TTOC(datetime()) + "  WW initialized to " + m.http_adresa + "  - - -"
auth_json = http_auth()


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

get_HTTP = CREATEOBJECT("wwHttp")
DO set_http_parms WITH get_HTTP, "GET"

IF VARTYPE(http_auth_token) = "C" .and. LEN(m.http_auth_token) > 11
    get_HTTP.AddHeader('Authorization', m.http_auth_token)
*    DO http_log WITH '', 'AddHeader:' + CRLF + '"Authorization"' + ': ' + '"' + 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.request_string + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" + STR(m.http_poradi_requestu, 5)

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', m.http_auth_token)
*            DO http_log WITH '', 'AddHeader:' + CRLF + '"Authorization"' + ': ' + '"' + 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.request_string + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" + STR(m.http_poradi_requestu, 5)
    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
http_poradi_requestu = m.http_poradi_requestu + 1

pp_HTTP = CREATEOBJECT("wwHttp")
DO set_http_parms WITH pp_HTTP, "PUT"

IF VARTYPE(http_auth_token) = "C" .and. LEN(m.http_auth_token) > 11
    pp_HTTP.AddHeader('Authorization', m.http_auth_token)
*    DO http_log WITH '', 'AddHeader:' + CRLF + '"Authorization"' + ': ' + '"' + 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()

DO CASE
CASE VARTYPE(http_read_only_mode) = "U"
    retval_string = sloz_response_string ( pp_HTTP.HttpGet(m.request_string), pp_HTTP.cResultCode, pp_HTTP.cResultCodeMessage, pp_HTTP.nError, pp_HTTP.cErrorMSg )
CASE EMPT(http_read_only_mode)
    retval_string = sloz_response_string ( pp_HTTP.HttpGet(m.request_string), pp_HTTP.cResultCode, pp_HTTP.cResultCodeMessage, pp_HTTP.nError, pp_HTTP.cErrorMSg )
OTHERWISE
    retval_string = "200 OK http_read_only_mode"
ENDCASE

DO http_log WITH m.retval_string, m.sloveso + " " + m.request_string + " (" + ALLTRIM(STR(SECONDS() - m.http_zacatek_prace, 7, 2)) + "sec)" + STR(m.http_poradi_requestu, 5) + IIF(EMPTY(m.body_string), "", CRLF + CHR(9) + "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', m.http_auth_token)
*            DO http_log WITH '', 'AddHeader:' + CRLF + '"Authorization"' + ': ' + '"' + 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)" + STR(m.http_poradi_requestu, 5) + IIF(EMPTY(m.body_string), "", CRLF + CHR(9) + "BODY>>> " + m.body_string + " <<<BODY ")
    ENDIF 

ENDIF 

pp_HTTP.httpclose()
RETURN m.retval_string 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_auth 
auth_HTTP=CREATEOBJECT("wwHttp")

IF ATC("GLOBUS.CZ", m.http_adresa) > 0
    RETURN http_auth_globus ()
ELSE
    RETURN http_auth_verze_2()
ENDIF 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_auth_verze_2

auth_request_string = m.http_adresa + "auth/v2/get_token"
DO set_http_parms WITH auth_HTTP, "PUT"
auth_HTTP.AddPostKey()    && to reset post buffer
auth_HTTP.AddPostKey(strconv(strconv(http_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 )

jmeno_pocitace = UPPER(m.machine)
IF AT("@", jmeno_pocitace) > 1
    jmeno_pocitace = LEFT(m.jmeno_pocitace, AT("@", m.jmeno_pocitace)-1)
ENDIF 

DO http_log WITH m.auth_retval_string, "AUTH " + m.http_adresa + CRLF + chr(9) + retez_programu() + " from " + m.jmeno_pocitace + "/" + m.gcuser_id
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 http_auth_verze_1

auth_request_string = m.http_adresa + "auth/v1/get_token"
DO set_http_parms WITH auth_HTTP, "PUT"
auth_HTTP.AddPostKey()    && to reset post buffer
auth_HTTP.AddPostKey(strconv(strconv(http_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()

http_auth_token = "-DENIED-"
IF json_ok(m.auth_retval_string)
    http_auth_token = get_string_item (m.auth_retval_string, "token")
    IF VARTYPE(m.http_auth_token) = "C"
        http_auth_token = "Token " + m.http_auth_token 
    ENDIF 
ENDIF 
RETURN m.auth_retval_string 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE http_auth_globus

auth_request_string = m.http_adresa + "connect/token"
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", "ehdkpPEk9hkksSmRa"     )
auth_HTTP.AddPostKey("client_id"    , "cashRegisterAlto"      )
auth_HTTP.AddPostKey("scope"        , "apiGastroCashRegister" )

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

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" nebo 201 Created
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION json_ok (json)
retval = LEFT(SUBSTR(json, ATC('"http_status":', m.json)+11), 22)
DO CASE 
CASE ("200" $ m.retval .and. ATC(  "OK"   , m.retval) > 0)
*    wait m.retval + "    200 je OK" at 22,22 wind time 2
    RETURN .T.
CASE ("201" $ m.retval .and. ATC("Created", m.retval) > 0)
*    wait m.retval + "    201 je taky OK" at 22,22 wind time 2
    RETURN .T.
CASE ("204" $ m.retval .and. ATC("No Cont", m.retval) > 0)
*    wait m.retval + "    204 je taky OK" at 22,22 wind time 2
    RETURN .T.
OTHERWISE 
    wait m.retval + ": neni OK" at 22,22 wind time 2
    RETURN .F.
ENDCASE 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
*      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 = 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
   texticek = SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3, 33)
   IF ATC("null", LEFT(texticek, 6)) = 0
       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 
       o_set_point = SET("POINT")
       SET POINT TO "."
       retval = VAL(m.textcislo)
       SET POINT TO (m.o_set_point)
       RETURN m.retval
   ELSE 
       RETURN .null.
   ENDIF 
ELSE
   RETURN .null.
ENDIF 

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION get_boolean_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, 33)
   IF ATC("null", LEFT(texticek, 6)) = 0
       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 = ATC("true", m.textcislo) > 0
       RETURN m.retval
   ELSE
       RETURN .null.
   ENDIF 
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 = ALLTRIM(SUBSTR(m.json, m.at_item + LEN(ALLTRIM(m.item)) + 3, 3333))
    IF ATC("null", LEFT(texticek, 6)) = 0
        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
        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.

*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
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 beautify_json (odpoved)
return_string = ""
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)
          return_string = return_string + CHR(13)+CHR(10)
          delka_radku = 0
       ELSE
          delka_radku = delka_radku + 1
       ENDIF
       return_string = return_string + m.pismenko
       predposledni = m.pismenko
   ENDIF
ENDFOR 
RETURN m.return_string

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

#DEFINE NEJMENSI_HLASENA_DELKA 999

IF VARTYPE(http_logovat) # "U" .and. EMPTY(m.http_logovat)
     * n i c
ELSE 
     log_prefix = CRLF + REPLICATE("      *", 22) + CRLF + LEFT(TTOC(DATETIME(), 3), 16) + "  " + IIF(VARTYPE(poznamecka)="C", m.poznamecka, "")
     IF LEN(m.text_do_logu) > NEJMENSI_HLASENA_DELKA
         log_prefix = log_prefix + CRLF + CHR(9) + "response length: " + ALLTRIM(TRANS(LEN(m.text_do_logu), "9999 999"))
     ENDIF 
     IF ATC("evzen", m.machine) > 0
         STRTOFILE( log_prefix + CRLF + STRTRAN(m.text_do_logu, '{"', CRLF + '{"') + CRLF, m.http_jmeno_logu, 1 )
     ELSE
         STRTOFILE( log_prefix + CRLF + STRTRAN(m.text_do_logu, '{"id', CRLF + '{"id') + CRLF, m.http_jmeno_logu, 1 )
     ENDIF 
ENDIF 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
PROCEDURE oznam_hotovo
ACTIVATE SCREEN
? CRLF + CRLF + PADC("      HOTOVO      ", 99, " -") + CRLF
WAIT CLEAR 


*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    
PROCEDURE publikuj
LPARAMETERS jmeno_promenne, default_value
LOCAL nastavit_hodnotu
nastavit_hodnotu = (PARAMETERS() > 1)
IF TYPE(jmeno_promenne) = "U" 
    PUBLIC (jmeno_promenne)
ENDIF 
IF m.nastavit_hodnotu 
    &jmeno_promenne = m.default_value
ENDIF 


*    *    *    *    *    *    *    *    *    *    *    
FUNCTION parsuj_adresu_a_credentials

pozice = AT("://", m.cely_string)
IF m.pozice > 0
    http_adresa = LEFT(m.cely_string, m.pozice+2)
    cely_string = SUBSTR(m.cely_string, m.pozice+3)
ELSE
    http_adresa = LEFT(m.cely_string, m.pozice-1)
ENDIF 

pozice = AT("@", m.cely_string)   && je zadan i uzivatel a (mozna) heslo
IF m.pozice > 0
    http_adresa = m.http_adresa + SUBSTR(m.cely_string, m.pozice+1)
    cely_string = LEFT(m.cely_string, m.pozice-1)
    pozice = AT(":", m.cely_string)   && je zadan i uzivatel a heslo oddelene dvojteckou
    IF m.pozice > 0
         auth_string = '{"username":"' + LEFT(m.cely_string, m.pozice-1) + '", "password":"'+ SUBSTR(m.cely_string, m.pozice+1) + '"}'
    ENDIF 

ELSE
    http_adresa = m.http_adresa + m.cely_string
    cely_string = ""
ENDIF 
http_adresa = m.http_adresa + IIF(RIGHT(m.http_adresa, 1)="/", "", "/")




********** vraci string + uvozovky  **********
FUNCTION tx2 (retez)
RETURN '"' + ALLTRIM(STRTRAN(IIF(ISNULL(m.retez), "", m.retez), '"', "'")) + '"'


********** vraci string bez mezer + uvozovky  **********
FUNCTION tx (retez)
retval = STRTRAN(m.retez, " ", "")
RETURN '"' + ALLTRIM(STRTRAN(retval, '"', "'")) + '"'


********** vraci string  **********
FUNCTION xx (retez)
RETURN ALLTRIM(STRTRAN(retez, '"', "'"))


********** vraci stringove datetime  **********
FUNCTION dat_time2datetime(dat, cas)
RETURN  "20" + RIGHT(m.dat, 2) + "-" + SUBSTR(m.dat, 4, 2) + "-" + LEFT(m.dat,2) + "T" + STRTRAN(m.cas, '"', '')


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION pocitej (krok, co_se_pocita)
IF EMPT(m.krok)
    krok = 6666
ENDIF
IF EMPTY(m.co_se_pocita)
    co_se_pocita = RECNO()
ENDIF 

DO CASE 
CASE m.co_se_pocita % (m.krok * 10) = 0
    ?? LEFT(ALLTRIM(STR(m.co_se_pocita)), 2)
CASE m.co_se_pocita % m.krok        = 0
    ?? "."
ENDCASE 


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


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION nastav_jmeno_logu

IF VARTYPE(gchom_path) = "C"
    zacatek_jmena_logu = m.gchom_path + "data\"
    DO mk_dir WITH       m.gchom_path + "data"
    IF .not. DIRECTORY(m.gchom_path + "data")
        zacatek_jmena_logu = ".\"
    ENDIF 
ELSE
    zacatek_jmena_logu     = ".\"
ENDIF 
zacatek_jmena_logu = m.zacatek_jmena_logu + "zu_http"

http_konec_jmena_logu = SUBSTR(CHRTRAN(TTOC(DATETIME(), 3), ":", ""), 3, 13)
IF ATC("evzen", m.machine) > 0
    http_jmeno_logu = m.zacatek_jmena_logu + m.http_konec_jmena_logu + ".txt"
ELSE
    http_jmeno_logu = m.zacatek_jmena_logu + LEFT(m.http_konec_jmena_logu, 5) + ".txt"            && 1 soubor mesicne
    pocetlogu = ADIR(logy, m.http_jmeno_logu)
    IF m.pocetlogu = 1 .and. logy(1,2) > 222000
        http_jmeno_logu = m.zacatek_jmena_logu + LEFT(m.http_konec_jmena_logu, 8) + ".txt"        && 1 soubor denne
        pocetlogu = ADIR(logy, m.http_jmeno_logu)
        IF m.pocetlogu = 1 .and. logy(1,2) > 222000
            http_jmeno_logu = m.zacatek_jmena_logu + LEFT(m.http_konec_jmena_logu, 11) + ".txt"   && 1 soubor za hodinu
        ENDIF 
    ENDIF 
ENDIF 


*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  
FUNCTION pridej_path
IF ADIR(qqq, http_path + "\" + "west-wind\wwClient.*") = 0
    http_path = JUSTPATH(m.http_path)
ENDIF 

IF ADIR(qqq, http_path + "\" + "west-wind\wwClient.*") > 0
    IF ATC(http_path + "\" + "west-wind", SET("PATH")) = 0
        SET PATH TO (http_path + "\" + "west-wind")         ADDITIVE 
        SET PATH TO (http_path + "\" + "west-wind\classes") ADDITIVE 
    ENDIF 
ENDIF 
