Author Topic: JSon to Rexx (stem)  (Read 39699 times)

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
JSon to Rexx (stem)
« on: February 24, 2013, 09:06:58 am »
Hello,

couldn't hold back, had to write some rexx code to parse a JSon file.
I've tested and adjusted the code to handle variations to it, so it should be quite stable.
It should cope with incomplete input as well, but it will then return a non 0 value to indicate how far from complete the input is.

There are many services out there that pass data in JSon format.
Code: [Select]
/*
 * Filename: JSon2Rx.cmd
 *   Author: Jan-Erik
 *  Created: Sat Feb 23 2013
 *  Purpose: Interpret a JSon-file and place in stem
 *  Changes:
 */

IF ARG() > 0 THEN
    IF STREAM( ARG(1), 'C', 'QUERY EXISTS' ) <> '' THEN
        f_name = ARG(1)
    ELSE
        f_name = 'london.json'
ELSE
    f_name = 'london.json'

IF STREAM( f_name, 'C', 'QUERY EXISTS' ) = '' THEN RETURN 1
f_size = STREAM( f_name, 'C', 'QUERY SIZE' )
f_input = CHARIN( f_name, 1, f_size )
CALL STREAM f_name, 'C', 'CLOSE'

stem = 'json.'
DO WHILE fromJSon( f_input ) > 0
    CALL CHAROUT 'STDERR', 'Parts of the file missing! Press Enter to read it again. '
    PARSE PULL
    f_size = STREAM( f_name, 'C', 'QUERY SIZE' )
    f_input = CHARIN( f_name, 1, f_size )
    CALL STREAM f_name, 'C', 'CLOSE'
END
   
DO i = 1 TO json.0
    SAY json.i '=' VALUE( json.i )
END

RETURN 0

fromJSon: PROCEDURE EXPOSE (stem)
    !_str_json_! = ARG(1)
    !_stem_counter_! = 0
    !_not_in_key_range_! = SPACE( TRANSLATE( XRANGE(),, XRANGE( 'a', 'z' )||XRANGE( 'A', 'Z' )||XRANGE( 0, 9 )||'_' ), 0 )
    IF SYMBOL( stem ) <> 'LIT' THEN
        stem = 'STEM'
    stem = STRIP( TRANSLATE( stem ), 'T', '.' )
    !_s_name_! = stem
    DO WHILE LENGTH( !_str_json_! ) > 0
        PARSE VALUE !_str_json_! WITH !_key_!':'!_str_json_!
        IF POS( '{', STRIP( !_key_! ) ) = 1 THEN
        DO
            PARSE VALUE !_key_! WITH '{'!_key_!
            !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
        END
        CALL calc4Pos
        IF !_strt_brkt_! < !_key_val_del_! & !_strt_brkt_! < !_end_brkt_! & 0 < !_strt_brkt_! THEN
        DO
            PARSE VALUE !_str_json_! WITH '{'!_str_json_!
            !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
            IF !_strt_sqr_brkt_! < !_strt_brkt_! & 0 < !_strt_sqr_brkt_! THEN
            DO
                !_s_name_! = !_s_name_!'.'TRANSLATE( !_key_! )'.0'
                IF POS( '.', !_s_name_! ) > 0 THEN
                DO
                    PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
                    !_n_! = REVERSE( !_n_! )
                    !_s_name_! = REVERSE( !_s_name_! )
                    IF DATATYPE( !_n_!, 'W' ) THEN
                    DO
                        !_n_! = !_n_! + 1
                        CALL VALUE !_s_name_!'.0', !_n_!
                    END
                    !_s_name_! = !_s_name_!'.'!_n_!
                END
                ELSE
                    !_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
            END
            ELSE
                !_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
            ITERATE
        END
        !_stem_counter_! = !_stem_counter_! + 1
        PARSE VALUE !_str_json_! WITH !_val_!','!_str_json_!
        PARSE VALUE !_val_! WITH !_val_!'}'!_rest_!
        !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
        IF POS( '"', !_val_! ) > 0 THEN
            PARSE VALUE !_val_! WITH '"'!_val_!'"'
        !_val_! = STRIP( STRIP( STRIP( STRIP( STRIP( STRIP( !_val_! ), 'T', D2C(10) ), 'T', D2C(13) ) ),, '"' ) )
        CALL VALUE !_s_name_!'.'TRANSLATE( !_key_! ), !_val_!
        CALL VALUE VALUE( stem )'.'!_stem_counter_!, !_s_name_!'.'TRANSLATE( !_key_! )
        CALL VALUE VALUE( stem )'.0', !_stem_counter_!
        IF ( !_end_brkt_! < !_key_val_sep_! | !_key_val_sep_! = 0 )  & ( !_end_brkt_! < !_end_sqr_brkt_! | !_end_sqr_brkt_! = 0 ) THEN
        DO
            !_n_! = ''
            !_rest_! = '}'||SPACE( TRANSLATE( !_rest_!,, SPACE( TRANSLATE( XRANGE(),, '}]' ), 0 ) ), 0 )
            DO WHILE LENGTH( !_rest_! ) > 0
                PARSE VALUE !_rest_! WITH !_sign_! +1 !_rest_!
                IF POS( '.', !_s_name_! ) > 0 THEN
                DO
                    PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
                    !_s_name_! = REVERSE( !_s_name_! )
                    !_n_! = REVERSE( !_n_! )
                    IF DATATYPE( !_n_!, 'W' ) & LEFT( !_rest_!, 1 ) <> ']' THEN
                    DO
                        !_n_! = !_n_! + 1
                        !_s_name_! = !_s_name_!'.'!_n_!
                    END
                END
            END
        END
    END
RETURN COUNTSTR( '.', !_s_name_! ) /* IF retval > 0 THEN INCOMPLETE FILE OR ERROR IN FUNCTION */

calc4Pos:
    !_strt_sqr_brkt_! = POS( '[', !_str_json_! )
    !_end_sqr_brkt_! = POS( ']', !_str_json_! )
    !_strt_brkt_! = POS( '{', !_str_json_! )
    !_end_brkt_! = POS( '}', !_str_json_! )
    !_key_val_sep_! = POS( ',', !_str_json_! )
    !_key_val_del_! = POS( ':', !_str_json_! )
RETURN 0


/* Count the number of occurances of needle in haystack from start pos to end pos (whole string by default) */
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
    IF TRACE() = '?I' THEN CALL TRACE 'O'
    IF ARG() < 2 THEN RETURN -1
    IF DATATYPE( ARG(3), 'W' ) THEN
        next = ARG(3)
    ELSE
        next = 1
    needle = ARG(1)
    haystack = ARG(2)
    IF DATATYPE( ARG(4), 'W' ) THEN
        haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
    next = 1
    count = 0
    DO WHILE next > 0
        next = POS( needle, haystack, next )
        IF next > 0 THEN DO
            next = next + LENGTH( needle )
            count = count + 1
        END
    END
RETURN count

It's much easier to update a rexx script than a compiled application if they change something.
The rexx script should however pass the collected data to the desktop application.

Wouldn't mind to have a weather widget in eCS to show the weather and forecasts. OpenWeatherMap
I know there are additions to eCenter, but wouldn't mind something more than text.

Anyone feel up to write a eCenter/SysTray/Desktop widget with graphics?
I'd suggest to combine it with transparent png's to make it pleasant to use and look at!

//Jan-Erik

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Practical use, current weather
« Reply #1 on: March 03, 2013, 05:05:08 pm »
And here's the totally insane code to retrieve information about the weather and write it to a ini file that other apps can use. The script store the found information for later use in a file called OpenWeather.ini

Please do test the code to see if it work and report back to me. Be aware that cut and paste + line feed may cause problems you need to resolv first.

The current code expand the radius for the search area from 1 km to a maximum of 101 km in the current setup.
I think that should be sufficient!

Usage:
OpenWeather
Automatic mode, tries to determine your position on the globe and the nearest weather station available and then the nearest town, use the default name "geo"

OpenWeather mums_house COORDS 61.32 17.45
Tries to find the nearest weather station to the coordinates specified and name the entry "mums_house" in the ini-file

OpenWeather summerhouse CITY Barcelona
Name the entry in the ini-file "summerhouse" and find the current weather for Barcelona

OpenWeather mums_house
To refresh the data about weather for that entry

Code: [Select]
/*
 * Filename: OpenWeather.cmd
 *   Author: Jan-Erik
 *  Created: Mon Feb 25 2013
 *  Purpose:
 *  Changes:
 */


/* initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
   rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
   rc = SockLoadFuncs()
end

label = ''
stem = 'GEO.'

PARSE SOURCE . callType .
IF callType = "COMMAND" THEN
DO
    label = SUBWORD( ARG(1), 1, 1 )
    type = SUBWORD( ARG(1), 2, 1 )
    param = SUBWORD( ARG(1), 3 )
END
ELSE IF ARG() > 1 THEN
    PARSE VALUE ARG label, type, param

label = TRANSLATE( label )
type = TRANSLATE( type )

label = SPACE( TRANSLATE( label,, SPACE( TRANSLATE( XRANGE(),, XRANGE( 'A', 'Z' )||XRANGE( 0, 9 )||'_' ), 0 ) ), 0 )

IF LENGTH( label ) > 0 THEN
    stem = label||'.'

IF type = 'COORDS' THEN
DO
    CALL VALUE stem'LATITUDE' = SUBWORD( param, 1, 1 )
    IF \DATATYPE( VALUE( stem'LATITUDE' ), 'N' ) THEN
        CALL VALUE stem'LATITUDE', ''
    CALL VALUE stem'LONGITUDE', SUBWORD( param, 2, 1 )
    IF \DATATYPE( VALUE( stem'LONGITUDE' ), 'N' ) THEN
        CALL VALUE stem'LONGITUDE', ''
END
ELSE IF type = 'CITY' THEN
    CALL VALUE stem'CITY', param
ELSE IF type = 'COUNTRIES' THEN
    RETURN rxLoadCountryCodes()

CALL PreCfg
reStart:

/* Split up the url into components */
    DO WHILE rxConnect() > -1
        /* Retrieve data from host */
        IF rxURLRetrieve() < 0 THEN
            SAY 'No data available.'
        ELSE DO
            PARSE VALUE text WITH .'{'text
            text = '{'||text
            IF fromJSon( text ) > 0 THEN CALL reStart
            stem = stem||'.'
        END
        IF VALUE( stem'CITY' ) <> stem'CITY' & TRANSLATE( VALUE( stem'CITY' ) ) <> 'NULL' & VALUE( stem'CITY' ) <> '' THEN RETURN ReadWriteCfg( 1 )
        IF type = 'COORDS' & DATATYPE( VALUE( stem'LAT' ), 'N' ) & DATATYPE( VALUE( stem'LON' ), 'N' ) THEN RETURN ReadWriteCfg( 1 )
    END
RETURN 1

rxURLConnect: PROCEDURE EXPOSE (stem)
/* The following lines add new host to the array if you try to connect to several within the same script */
/* If none has been added before (host.0 is uninitialized) */
IF \DATATYPE( VALUE( stem'host.0' ), 'W' ) THEN
    CALL VALUE stem'host.0', 0
/* Make room for another */
j = VALUE( stem'host.0' ) + 1
/* Check if the host has been used already, then leave */
DO i = 1 TO VALUE( stem'host.0' )
    IF TRANSLATE( VALUE( stem'host.'i'.location' ) ) = TRANSLATE( VALUE( stem'host.'j'.location' ) ) THEN LEAVE
END
/* If the host has not been added before, add it and check the ip-address (can take quite some time) */
IF i > VALUE( stem'host.0' ) THEN
DO
    /* get dot address of host */
    IF 1 <> SockGetHostByName( VALUE( stem'host.'i'.location' ), stem||"host."i"." ) THEN
        CALL LINEOUT 'STDERR', VALUE( stem'host.'i'.location' )||" is unknown and can't be found."
END
ELSE
    CALL VALUE  stem'host.'j'.addr', VALUE( stem||'host.'i'.addr' )

/* Set the number of unique hosts */
    CALL VALUE stem'host.0', j
    i = j

/* Close the connection if already open but not closed */
    IF SYMBOL( VALUE( stem'host.'i'.socket' ) ) = 'VAR' THEN
        rc = SockClose( VALUE( stem'host.'i'.socket' ) )

/* Create socket */
    CALL VALUE stem'host.'i'.socket', SockSocket( VALUE( stem'host.'i'.family' ), "SOCK_STREAM", 0 )
    IF rc < 0 THEN
        CALL LINEOUT 'STDERR', "Error creating socket: "||errno

/* Connect it to the server */
    rc = SockConnect( VALUE( stem'host.'i'.socket' ), stem"host."i"." )
    IF rc < 0 THEN
        CALL LINEOUT 'STDERR', "Error connecting to "||VALUE( stem'host.'i'.addr' )" :"||errno
RETURN rc

rxURLRetrieve: PROCEDURE EXPOSE (stem) text output
/* send message across ... loop in case entire message can't be sent in one SockSend() */
    i = VALUE( stem'host.0' )
    message = 'T /'||VALUE( stem'host.'i'.path' )||' HTTP/1.1'||"0D0A"x||'Host: '||VALUE( stem'host.'i'.location' )
    IF LENGTH( ARG(1) ) > 0 THEN
        message = 'POS'||message||"0D0A"x||ARG(2)||"0D0A0D0A"x
    ELSE IF SYMBOL( VALUE( stem'host.'i'.cookie' ) ) = 'VAR' THEN
        message = 'GE'||message||"0D0A"x||'Cookie: '||VALUE( stem'host.'i'.cookie' )||"0D0A0D0A"x
    ELSE
        message = 'GE'||message||"0D0A0D0A"x

    DO WHILE ( message <> "" )
        bytes = SockSend( VALUE( stem'host.'i'.socket' ), message )
        message = SUBSTR( message, bytes + 1 )
    END
    CALL LINEOUT 'STDERR', VALUE( stem'host.'i'.location' )||' contacted '||date()||' '||time()

    text = ''
    CALL SysSleep 0.5
    onoff = 0
    ret_len = 1000
    IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
    DO WHILE rc > -1 & chunk <> '' & LENGTH( text ) < ret_len
        rc = SockRecv( VALUE( stem'host.'i'.socket' ), 'chunk', ret_len )
        IF POS( 'CONTENT-LENGTH:', TRANSLATE( chunk ) ) > 0 THEN
            PARSE UPPER VALUE chunk WITH ."CONTENT-LENGTH:" ret_len "0D0A"x
        IF onoff = 0 THEN DO
            PARSE VALUE chunk WITH ."0D0A0D0A"x chunk
            onoff = 1
        END
        text = text||chunk
        ret_len = STRIP( ret_len )
        IF \DATATYPE( ret_len, 'W' ) THEN
            ret_len = 1000
    END
/* wait for server to close the connection, then close our end */
    rc = SockClose( VALUE( stem'host.'i'.socket' ) )
    INTERPRET 'DROP '||stem'host.'||i||'.socket'
RETURN rc /*text*/

rxURLComponents: PROCEDURE EXPOSE (stem)
    CALL GetURLComponents ARG( 2 )
    CALL VALUE ARG(1)'scheme', host.scheme
    CALL VALUE ARG(1)'location', host.location
    CALL VALUE ARG(1)'port', host.port
    CALL VALUE ARG(1)'params', host.params
    CALL VALUE ARG(1)'query', host.query
    CALL VALUE ARG(1)'target', host.target
    CALL VALUE ARG(1)'file', host.file
    CALL VALUE ARG(1)'family', host.family
    CALL VALUE ARG(1)'path', host.path
RETURN

GetURLComponents: PROCEDURE EXPOSE host.
/* URL syntax consists of these components:          */
/* <scheme>://<location>:<port>/<path><params>?<query>#<target> */

    PARSE VALUE ARG( 1 ) WITH host.scheme '://' host.location '/' host.path
    host.location = strip( host.location, 'L', '/' ) /* in case of scheme like "file:///" */

    IF host.location = '' THEN
        PARSE VALUE ARG( 1 ) WITH host.location '/' host.path

    PARSE VALUE host.location WITH host.location ':' host.port
    IF host.port = '' THEN
        IF TRANSLATE( host.scheme ) = 'HTTP' then
            host.port = 80
        ELSE IF TRANSLATE( host.scheme ) = 'FTP' then
            host.port = 21

    PARSE VALUE host.path WITH host.file '' host.params '?' host.query '#' host.target

    IF host.params = '' THEN
        PARSE VALUE host.path WITH host.file '?' host.query '#' host.target

    IF host.query = '' THEN
        PARSE VALUE host.path WITH host.file '#' host.target

    host.family = "AF_INET"

RETURN

rxLoadCountryCodes:
    IF SYMBOL( code.shrt ) <> 'LIT' | LENGTH( ARG(1) ) > 0 THEN
    DO
        country_code = 'cc.cfg'
        DO WHILE LINES( country_code ) > 0
            PARSE VALUE LINEIN( country_code ) WITH code.country','code.shrt';'code.long'#'code.num
        END
        PARSE VALUE VALUE( 'COUNTRY',, 'OS2ENVIRONMENT' ) WITH country_num';'.
        IF DATATYPE( country_num, 'W' ) THEN RETURN code.num
    END
RETURN

fromJSon: PROCEDURE EXPOSE (stem)
    !_str_json_! = ARG(1)
    !_stem_counter_! = 0
    !_not_in_key_range_! = SPACE( TRANSLATE( XRANGE(),, XRANGE( 'a', 'z' )||XRANGE( 'A', 'Z' )||XRANGE( 0, 9 )||'_' ), 0 )
    IF SYMBOL( stem ) <> 'LIT' THEN
        stem = 'STEM'
    stem = STRIP( TRANSLATE( stem ), 'T', '.' )
    !_s_name_! = stem
    DO WHILE LENGTH( !_str_json_! ) > 0
        PARSE VALUE !_str_json_! WITH !_key_!':'!_str_json_!
        IF POS( '{', STRIP( !_key_! ) ) = 1 THEN
        DO
            PARSE VALUE !_key_! WITH '{'!_key_!
            !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
        END
        CALL calc4Pos
        IF !_strt_brkt_! < !_key_val_del_! & !_strt_brkt_! < !_end_brkt_! & 0 < !_strt_brkt_! THEN
        DO
            PARSE VALUE !_str_json_! WITH '{'!_str_json_!
            !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
            IF !_strt_sqr_brkt_! < !_strt_brkt_! & 0 < !_strt_sqr_brkt_! THEN
            DO
                !_s_name_! = !_s_name_!'.'TRANSLATE( !_key_! )'.0'
                IF POS( '.', !_s_name_! ) > 0 THEN
                DO
                    PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
                    !_n_! = REVERSE( !_n_! )
                    !_s_name_! = REVERSE( !_s_name_! )
                    IF DATATYPE( !_n_!, 'W' ) THEN
                    DO
                        !_n_! = !_n_! + 1
                        CALL VALUE !_s_name_!'.0', !_n_!
                    END
                    !_s_name_! = !_s_name_!'.'!_n_!
                END
                ELSE
                    !_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
            END
            ELSE
                !_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
            ITERATE
        END
        !_stem_counter_! = !_stem_counter_! + 1
        PARSE VALUE !_str_json_! WITH !_val_!','!_str_json_!
        PARSE VALUE !_val_! WITH !_val_!'}'!_rest_!
        !_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
        IF POS( '"', !_val_! ) > 0 THEN
            PARSE VALUE !_val_! WITH '"'!_val_!'"'
        !_val_! = STRIP( STRIP( STRIP( STRIP( STRIP( STRIP( !_val_! ), 'T', D2C(10) ), 'T', D2C(13) ) ),, '"' ) )
        CALL VALUE !_s_name_!'.'TRANSLATE( !_key_! ), !_val_!
        CALL VALUE VALUE( stem )'.'!_stem_counter_!, !_s_name_!'.'TRANSLATE( !_key_! )
        CALL VALUE VALUE( stem )'.0', !_stem_counter_!
        IF ( !_end_brkt_! < !_key_val_sep_! | !_key_val_sep_! = 0 )  & ( !_end_brkt_! < !_end_sqr_brkt_! | !_end_sqr_brkt_! = 0 ) THEN
        DO
            !_n_! = ''
            !_rest_! = '}'||SPACE( TRANSLATE( !_rest_!,, SPACE( TRANSLATE( XRANGE(),, '}]' ), 0 ) ), 0 )
            DO WHILE LENGTH( !_rest_! ) > 0
                PARSE VALUE !_rest_! WITH !_sign_! +1 !_rest_!
                IF POS( '.', !_s_name_! ) > 0 THEN
                DO
                    PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
                    !_s_name_! = REVERSE( !_s_name_! )
                    !_n_! = REVERSE( !_n_! )
                    IF DATATYPE( !_n_!, 'W' ) & LEFT( !_rest_!, 1 ) <> ']' THEN
                    DO
                        !_n_! = !_n_! + 1
                        !_s_name_! = !_s_name_!'.'!_n_!
                    END
                END
            END
        END
    END
RETURN COUNTSTR( '.', !_s_name_! ) /* IF retval > 0 THEN INCOMPLETE FILE OR ERROR IN FUNCTION */

calc4Pos:
    !_strt_sqr_brkt_! = POS( '[', !_str_json_! )
    !_end_sqr_brkt_! = POS( ']', !_str_json_! )
    !_strt_brkt_! = POS( '{', !_str_json_! )
    !_end_brkt_! = POS( '}', !_str_json_! )
    !_key_val_sep_! = POS( ',', !_str_json_! )
    !_key_val_del_! = POS( ':', !_str_json_! )
RETURN 0
   
NLS2HTMLHEX:
    retval = UTF.I( UTF.O( ARG(1), SysQueryProcessCodePage() ), 1004 )
    chstr = SPACE( TRANSLATE( retval,, XRANGE( D2C(32), D2C(126) ) ), 0 )
    DO i = 1 TO LENGTH( chstr )
        retval = CHANGESTR( SUBSTR( chstr, i, 1 ), retval, '%C3%'||D2X( C2D( SUBSTR( chstr, i, 1 ) ) - 32 ) )
    END
RETURN retval
   
/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle> */
    IF TRACE() = '?I' THEN CALL TRACE 'O'
    PARSE ARG needle, haystack, newneedle
    new_haystack = ''
    DO WHILE POS( needle, haystack ) > 0
        PARSE VALUE haystack WITH pre(needle)haystack
        new_haystack = new_haystack||pre||newneedle
    END
RETURN new_haystack||haystack
   
rxConnect: PROCEDURE EXPOSE (stem)
    CALL ReadWriteCfg
    IF \DATATYPE( VALUE( stem'host.0' ), 'W' ) THEN
        CALL VALUE stem'host.0', 0
    IF VALUE( stem'CITY' ) <> TRANSLATE( stem'CITY' ) & TRANSLATE( VALUE( stem'CITY' ) ) <> 'NULL' & VALUE( stem'CITY' ) <> '' THEN
    DO
        IF VALUE( stem'COUNTRY_CODE' ) <> TRANSLATE( stem'COUNTRY_CODE' ) & TRANSLATE( VALUE( stem'COUNTRY_CODE' ) ) <> 'NULL' & VALUE( stem'COUNTRY_CODE' ) <> '' THEN
            CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://api.openweathermap.org/data/2.1/find/name?q='||NLS2HTMLHEX( TRANSLATE( VALUE( stem'CITY' ) ) )||','||TRANSLATE( VALUE( stem'COUNTRY_CODE' ) )
        ELSE
            CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://api.openweathermap.org/data/2.1/find/name?q='||NLS2HTMLHEX( TRANSLATE( VALUE( stem'CITY' ) ) )
    END
    ELSE IF DATATYPE( VALUE( stem'LATITUDE' ), 'N' ) & DATATYPE( VALUE( stem'LONGITUDE' ), 'N' ) THEN
    DO
        IF DATATYPE( VALUE( stem'radius' ), 'W' ) THEN
            CALL VALUE stem'radius', VALUE( stem'radius' ) + 10
        ELSE
            CALL VALUE stem'radius', 1
        IF VALUE( stem'radius' ) < 102 THEN
            CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://api.openweathermap.org/data/2.1/find/city?lat='||VALUE( stem'LATITUDE' )||'&lon='||VALUE( stem'LONGITUDE' )||'&radius='||VALUE( stem'radius' )
        ELSE RETURN -1
    END
    ELSE
        CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://geoip.prototypeapp.com/api/locate'
RETURN rxURLConnect()

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
JSon to Rexx in paractical use, Weather information
« Reply #2 on: March 03, 2013, 05:06:25 pm »
continued...
Code: [Select]
   
ReadWriteCfg: PROCEDURE EXPOSE (stem)
    PARSE SOURCE . . this
    PARSE VALUE REVERSE( this ) WITH .'.'this
    this = REVERSE( this )||'.ini'
    IF \DATATYPE( VALUE( stem'0' ), 'W' ) THEN
    DO
        retval = SysIni( this, TRANSLATE( STRIP( stem, 'T', '.' ) ), 'ALL:', TRANSLATE( STRIP( stem, 'T', '.' ) ) )
        IF retval = '' THEN  /* Read Cfg */
        DO i = 1 TO VALUE( stem'0' )
            CALL VALUE VALUE( stem''i ), SysIni( this, TRANSLATE( STRIP( stem, 'T', '.' ) ), VALUE( VALUE( stem''i ) ) )
        END
    END
    IF DATATYPE( VALUE( stem'0' ), 'W' ) THEN
    DO i = 1 TO VALUE( stem'0' )
        PARSE VALUE REVERSE( VALUE( stem''i ) ) WITH tag'.'num'.'rest
        tag = REVERSE( tag )
        IF TRANSLATE( tag ) = 'NAME' THEN
            tag = 'CITY'
        ELSE IF DATATYPE( num, 'W' ) THEN
            tag = REVERSE( num )||'.'||tag
        IF TRANSLATE( VALUE( VALUE( stem''i ) ) ) <> 'NULL' & VALUE( VALUE( stem''i ) ) <> '' THEN
            IF ARG(1) = 1 THEN /* Write Cfg */
                CALL SysIni this, STRIP( stem, 'T', '.' ), stem''tag, VALUE( VALUE( stem''i ) )
            ELSE
                CALL VALUE stem''tag, VALUE( VALUE( stem''i ) )
    END
RETURN ( retval = 'ERROR:' )

PreCfg: PROCEDURE EXPOSE (stem)
    f_name = 'geo.cfg'
    DO WHILE LINES( f_name ) > 0
        PARSE VALUE LINEIN( f_name ) WITH tag_name' = 'tag_value
        IF TRANSLATE( tag_value ) <> 'NULL' & tag_value <> '' THEN
            CALL VALUE tag_name, tag_value
    END
    CALL STREAM f_name, 'C', 'CLOSE'
RETURN 0
   
/* Count the number of occurances of needle in haystack from start pos to end pos (whole string by default) */
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
    IF TRACE() = '?I' THEN CALL TRACE 'O'
    IF ARG() < 2 THEN RETURN -1
    IF DATATYPE( ARG(3), 'W' ) THEN
        next = ARG(3)
    ELSE
        next = 1
    needle = ARG(1)
    haystack = ARG(2)
    IF DATATYPE( ARG(4), 'W' ) THEN
        haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
    next = 1
    count = 0
    DO WHILE next > 0
        next = POS( needle, haystack, next )
        IF next > 0 THEN DO
            next = next + LENGTH( needle )
            count = count + 1
        END
    END
RETURN count
   
UTF.I:   procedure expose UTF.      /* UTF-8 to local charset     */
   parse arg SRC  ;  DST = ''       ;  UTF.8 = UTF.8( arg( 2 ))

   do while SRC <> ''
      POS = verify( SRC, UTF.8 ) -1 ;  if POS < 0 then leave
      DST = DST || left( SRC, POS ) ;  SRC = substr( SRC, POS + 1 )
      POS = verify( x2b( c2x( left( SRC, 1 ))), 1 ) -1

      if POS > 1 & POS < 7 then  do /* C0..FD introduce 2-6 bytes */
         TOP = left( SRC, POS )     ;  SRC = substr( SRC, POS + 1 )
         DST = DST || UTF.TOP       /* surrogates implicitly bad, */
      end                           /* C0..C1 are implicitly bad, */
      else  do                      /* 80..BF and FE..FF illegal: */
         DST = DST || UTF.?         ;  SRC = substr( SRC, 2 )
      end                           /* show error character UTF.? */
   end
   return DST || SRC

UTF.O:   procedure expose UTF.      /* local charset to UTF-8     */
   parse arg SRC  ;  DST = ''       ;  UTF.8 = UTF.8( arg( 2 ))

   do while SRC <> ''
      POS = verify( SRC, UTF.8 ) -1 ;  if POS < 0 then leave
      DST = DST || left( SRC, POS ) ;  SRC = substr( SRC, POS + 1 )
      parse var SRC TOP 2 SRC       ;  DST = DST || UTF.TOP
   end
   return DST || SRC

UTF.8:   procedure expose UTF.      /* initialize Unicode table   */
   arg PAGE
   select
      when  PAGE = value( 'UTF..' )                then  nop
      when  PAGE = '' & symbol( 'UTF..' ) = 'VAR'  then  nop
   otherwise
      if symbol( 'UTF.?' ) = 'VAR'  then  T = UTF.?
                                    else  T = x2c( 1A )
      drop UTF.      ;  UTF. = T    /* SUB unknown char.s by 0x1A */
      UTF.. = PAGE   ;  T = ''      /* note actual codepage UTF.. */
      select                        /* -------------------------- */
         when  PAGE =  437 then  do                /*  US OEM DOS */
            T = T '  C7   FC   E9   E2   E4   E0   E5   E7' /* 80 */
            T = T '  EA   EB   E8   EF   EE   EC   C4   C5' /* 88 */
            T = T '  C9   E6   C6   F4   F6   F2   FB   F9' /* 90 */
            T = T '  FF   D6   DC   A2   A3   A5 20A7  192' /* 98 */
            T = T '  E1   ED   F3   FA   F1   D1   AA   BA' /* A0 */
            T = T '  BF 2310   AC   BD   BC   A1   AB   BB' /* A8 */
            T = T '2591 2592 2593 2502 2524 2561 2562 2556' /* B0 */
            T = T '2555 2563 2551 2557 255D 255C 255B 2510' /* B8 */
            T = T '2514 2534 252C 251C 2500 253C 255E 255F' /* C0 */
            T = T '255A 2554 2569 2566 2560 2550 256C 2567' /* C8 */
            T = T '2568 2564 2565 2559 2558 2552 2553 256B' /* D0 */
            T = T '256A 2518 250C 2588 2584 258C 2590 2580' /* D8 */
            T = T ' 3B1   DF  393  3C0  3A3  3C3   B5  3C4' /* E0 */
            T = T ' 3A6  398  3A9  3B4 221E  3C6  3B5 2229' /* E8 */
            T = T '2261   B1 2265 2264 2320 2321   F7 2248' /* F0 */
            T = T '  B0 2219   B7 221A 207F   B2 25A0   A0' /* F8 */
         end                        /* -------------------------- */
         when  PAGE =  858 | PAGE = 850   then do  /* western DOS */
            T = T '  C7   FC   E9   E2   E4   E0   E5   E7' /* 80 */
            T = T '  EA   EB   E8   EF   EE   EC   C4   C5' /* 88 */
            T = T '  C9   E6   C6   F4   F6   F2   FB   F9' /* 90 */
            T = T '  FF   D6   DC   F8   A3   D8   D7  192' /* 98 */
            T = T '  E1   ED   F3   FA   F1   D1   AA   BA' /* A0 */
            T = T '  BF   AE   AC   BD   BC   A1   AB   BB' /* A8 */
            T = T '2591 2592 2593 2502 2524   C1   C2   C0' /* B0 */
            T = T '  A9 2563 2551 2557 255D   A2   A5 2510' /* B8 */
            T = T '2514 2534 252C 251C 2500 253C   E3   C3' /* C0 */
            T = T '255A 2554 2569 2566 2560 2550 256C   A4' /* C8 */
            T = T '  F0   D0   CA   CB   C8 20AC   CD   CE' /* D0 */
            T = T '  CF 2518 250C 2588 2584   A6   CC 2580' /* D8 */
            T = T '  D3   DF   D4   D2   F5   D5   B5   FE' /* E0 */
            T = T '  DE   DA   DB   D9   FD   DD   AF   B4' /* E8 */
            T = T '  AD   B1 2017   BE   B6   A7   F7   B8' /* F0 */
            T = T '  B0   A8   B7   B9   B3   B2 25A0   A0' /* F8 */
            /* 0xD5 850: u+0131 small dotless i, 858: u+20AC Euro */
         end                        /* -------------------------- */
         when  PAGE =  819 | PAGE = 28591 then  do /* ISO 8859-1  */
            do N = 128 to 255 ;  T = T d2x( N ) ;  end N /* 80-FF */
         end                        /* -------------------------- */
         when  PAGE =  923 | PAGE = 28605 then  do /* ISO 8859-15 */
            do N = 128 to 159 ;  T = T d2x( N ) ;  end N /* 80-9F */
            T = T '  A0   A1   A2   A3 20AC   A5  160   A7' /* A0 */
            T = T ' 161   A9   AA   AB   AC   AD   AE   AF' /* A8 */
            T = T '  B0   B1   B2   B3  17D   B5   B6   B7' /* B0 */
            T = T ' 17E   B9   BA   BB  152  153  178   BF' /* B8 */
            do N = 192 to 255 ;  T = T d2x( N ) ;  end N /* C0-FF */
         end                        /* -------------------------- */
         when  PAGE = 1252 | PAGE = 1004  then  do /* OEM Latin-1 */
            T = T '20AC   81 201A  192 201E 2026 2020 2021' /* 80 */
            T = T ' 2C6 2030  160 2039  152   8D  17D   8F' /* 88 */
            T = T '  90 2018 2019 201C 201D 2022 2013 2014' /* 90 */
            T = T ' 2DC 2122  161 203A  153   9D  17E  17F' /* 98 */
            do N = 160 to 255 ;  T = T d2x( N ) ;  end N /* A0-FF */
         end                        /* -------------------------- */
         when  PAGE =  878 then  do /* KOI8-R (ibm-878)           */
            T = T '2500 2502 250C 2510 2514 2518 251C 2524' /* 80 */
            T = T '252C 2534 253C 2580 2584 2588 258C 2590' /* 88 */
            T = T '2591 2592 2593 2320 25A0 2219 221A 2248' /* 90 */
            T = T '2264 2265   A0 2321   B0   B2   B7   F7' /* 98 */
            T = T '2550 2551 2552  451 2553 2554 2555 2556' /* A0 */
            T = T '2557 2558 2559 255A 255B 255C 255D 255E' /* A8 */
            T = T '255F 2560 2561  401 2562 2563 2564 2565' /* B0 */
            T = T '2566 2567 2568 2569 256A 256B 256C   A9' /* B8 */
            T = T ' 44E  430  431  446  434  435  444  433' /* C0 */
            T = T ' 445  438  439  43A  43B  43C  43D  43E' /* C8 */
            T = T ' 43F  44F  440  441  442  443  436  432' /* D0 */
            T = T ' 44C  44B  437  448  44D  449  447  44A' /* D8 */
            T = T ' 42E  410  411  426  414  415  424  413' /* E0 */
            T = T ' 425  418  419  41A  41B  41C  41D  41E' /* E8 */
            T = T ' 41F  42F  420  421  422  423  416  412' /* F0 */
            T = T ' 42C  42B  417  428  42D  429  427  42A' /* F8 */
         end                        /* -------------------------- */
         when PAGE = '10000'  then  do   /* MAC Roman             */
            T = T '  C4   C5   C7   C9   D1   D6   DC   E1' /* 80 */
            T = T '  E0   E2   E4   E3   E5   E7   E9   E8' /* 88 */
            T = T '  EA   EB   ED   EC   EE   EF   F1   F3' /* 90 */
            T = T '  F2   F4   F6   F5   FA   F9   FB   FC' /* 98 */
            T = T '2020   B0   A2   A3   A7 2022   B6   DF' /* A0 */
            T = T '  AE   A9 2122   B4   A8 2260   C6   D8' /* A8 */
            T = T '221E   B1 2264 2265   A5   B5 2202 2211' /* B0 */
            T = T '220F  3C0 222B   AA   BA  3A9   E6   F8' /* B8 */
            T = T '  BF   A1   AC 221A  192 2248 2206   AB' /* C0 */
            T = T '  BB 2026   A0   C0   C3   D5  152  153' /* C8 */
            T = T '2013 2014 201C 201D 2018 2019   F7 25CA' /* D0 */
            T = T '  FF  178 2044 20AC 2039 203A FB01 FB02' /* D8 */
            T = T '2021   B7 201A 201E 2030   C2   CA   C1' /* E0 */
            T = T '  CB   C8   CD   CE   CF   CC   D3   D4' /* E8 */
            T = T 'F8FF   D2   DA   DB   D9  131  2C6  2DC' /* F0 */
            T = T '  AF  2D8  2D9  2DA   B8  2DD  2DB  2C7' /* F8 */
            /* 0xBD old u+2126 Ohm             : new u+03A9 Omega */
            /* 0xDB old u+00A4 currency symbol : new u+20AC Euro  */
            /* 0xF0 old u+2665 black heart suit: new u+F8FF priv. */
         end                        /* -------------------------- */
         OTHERWISE NOP
      end                           /* otherwise force REXX error */

      do N = 128 to 255             /* table of UTF-8 characters: */
         parse var T SRC T ;  DST = ''
         SRC = reverse( x2b( SRC )) /* scalar bits right to left  */

         do LEN = 2 until verify( substr( SRC, 8 - LEN ), 0 ) = 0
            DST = DST || left( SRC, 6, 0 ) || '01'
            SRC = substr( SRC, 7 )  /* encoded 6 bits of scalar   */
         end LEN                    /* remaining bits of scalar:  */
         DST = DST || left( SRC, 7 - LEN, 0 ) || 0
         DST = x2c( b2x( reverse( DST || copies( 1, LEN ))))

         SRC = d2c( N )             /* SRC: 1 byte (local char.)  */
         UTF.DST = SRC              /* DST: 2 or more UTF-8 bytes */
         UTF.SRC = DST              /* excluding us-ascii 0..127  */
      end N
   end
return xrange( x2c( 0 ), x2c( 7F ))
   
TRAP:                            /* select REXX exception handler */
   call trace 'O' ;  trace N           /* don't trace interactive */
   parse source TRAP                   /* source on separate line */
   TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
   TRAP = TRAP || right( '+++', 10 )   /* = standard trace prefix */
   TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' ))
   select
      when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
         if condition( 'd' ) > ''      /* need an additional line */
            then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
         TRAP = TRAP '(RC' rc || ')'   /* any system error codes  */
         if condition( 'c' ) = 'FAILURE' then rc = -3
      end
      when wordpos( condition( 'c' ), 'HALT SYNTAX'   ) > 0 then do
         if condition( 'c' ) = 'HALT' then rc = 4
         if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
            if condition( 'd' ) <> errortext( rc ) then do
               TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
               TRAP = TRAP errortext( rc )
            end                        /* future condition( 'd' ) */
         end                           /* may use errortext( rc ) */
         else  TRAP = TRAP errortext( rc )
         rc = -rc                      /* rc < 0: REXX error code */
      end
      when condition( 'c' ) = 'NOVALUE'  then rc = -2 /* dubious  */
      when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious  */
      otherwise                        /* force non-zero whole rc */
         if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
         if rc = 0                             then rc = 1
         if condition() = '' then TRAP = TRAP arg( 1 )
   end                                 /* direct: TRAP( message ) */

   TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
   signal on syntax name TRAP.SIGL     /* throw syntax error 3... */
   if 0 < sigl & sigl <= sourceline()  /* if no handle for source */
      then TRAP = TRAP '*-*' strip( sourceline( sigl ))
      else TRAP = TRAP '+++ (source line unavailable)'
TRAP.SIGL:                             /* ...catch syntax error 3 */
   if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
      TRAP = TRAP '+++ (source line unreadable)'   ;  rc = -rc
   end
   select
      when 0 then do                   /* in pipes STDERR: output */
         parse version TRAP.REXX       /* REXX/Personal: \dev\con */
         if abbrev( TRAP.REXX, 'REXXSAA ' ) |                /**/ ,
            6 <= word( TRAP.REXX, 2 )  then  TRAP.REXX = 'STDERR'
                                       else  TRAP.REXX = '\dev\con'
         signal on syntax name TRAP.FAIL
         call lineout TRAP.REXX , TRAP /* fails if no more handle */
      end
      when 0 then do                   /* OS/2 PM or ooREXX on NT */
         signal on syntax name TRAP.FAIL
         call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ ,
            'Trap' time(),, 'ERROR'
      end
      otherwise   say TRAP ; trace ?L  /* interactive Label trace */
   end

   if condition() = 'SIGNAL' then signal TRAP.EXIT
TRAP.CALL:  return rc                  /* continue after CALL ON  */
TRAP.FAIL:  say TRAP ;  rc = 0 - rc    /* force TRAP error output */
TRAP.EXIT:  exit   rc                  /* exit for any SIGNAL ON  */

melf

  • Guest
Re: JSon to Rexx (stem)
« Reply #3 on: March 03, 2013, 06:21:18 pm »
Hi Jan-Erik,
I'm not used to use Rexx, but anyway I pasted your code into a textfile "openweather.cmd" and executed... This rendered an ini-file which could be downloaded here, http://elfonnet.nu/pics/OPENWEATHER.INI . Seems to work well as far as I can see, but it seem to think I'm near Norrköping while I live in Gothenburg. Anyway this is exciting. Would be quite nice with  a weather widget that also has a some graphics as you say.

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #4 on: March 03, 2013, 09:58:00 pm »
Thank you melf for you feedback!

Seems like Norrköping have clear weather and almost 4°C (277.05-273.15) as seen in "geo.temp"
while Gothenburg have clear weather and -3°C (270.02-273.15)

Please do try to delete the file and run the command:
OpenWeather geo CITY Goteborg
(yes without the dots over it) to set info for Gothenburg
You can then use just the command OpenWeather to update the info for Gothenburg.


The reason to why it found Norrköping and not Gothenburg may come from the fact that the service it use rely on information from your ISP I guess.

You can read the script and see what services it use... http://geoip.prototypeapp.com/api/locate tries to locate you and they state that it's in alpha stage. Another and perhaps better service would be smashing.

Hmm, OpenWeatherMap is a bit picky about the spelling of the city name.

//Jan-Erik

guzzi

  • Sr. Member
  • ****
  • Posts: 331
  • Karma: +0/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #5 on: March 03, 2013, 10:41:33 pm »
Here it detects the right location, can't seem to post the ini file as attachment .

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #6 on: March 04, 2013, 08:06:05 am »
Great!

Thank you guzzi for the feedback!

Hope you all don't mind that it tries to do find the position automatically.

//Jan-Erik

melf

  • Guest
Re: JSon to Rexx (stem)
« Reply #7 on: March 04, 2013, 10:10:40 am »
//-----
Please do try to delete the file and run the command:
OpenWeather geo CITY Goteborg
(yes without the dots over it) to set info for Gothenburg
You can then use just the command OpenWeather to update the info for Gothenburg. -------//


That worked fine! Also tried some other smaller places in Sweden. It seems to quite well chose bigger nearby cities. E.g.  "OpenWeather geo CITY Veddige" returned data for Varberg, while "OpenWeather geo CITY Kungsater" returned data for Kinna. This is really quite good!

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #8 on: March 05, 2013, 09:58:23 am »
Thank you melf, very good information!

I'll have to adjust a line in the code to allow you to not find the nearest city but stop on the nearest weather station as you specify the longitude and latitude.

The code has to be corrected as it now set Elur, India as the nearest town if you try to replace a city with a new one.

//Jan-Erik

guzzi

  • Sr. Member
  • ****
  • Posts: 331
  • Karma: +0/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #9 on: March 06, 2013, 07:24:29 pm »
I noticed something strange. The weather wasn't correct, so I looked at the location and noticed I was suddenly in Rotterdam near Schenectady:-)
After using it with the City parm it was correct again and I'm back in the Netherlands, even when using without the parm...

lmotaku

  • Guest
Re: JSon to Rexx (stem)
« Reply #10 on: March 19, 2013, 10:57:52 pm »
Probably reviving a dead topic, but I'm looking to do something similar, however, I am looking to parse the request through my own server before fetching the result. I'm going to fetch a url over http, and use my servers response as a txt file. Each line being something distinct to give back on the desktop.

I'm thinking of using http://rexxcurl.sf.net to pull it all together, since I know more php than I do Rexx.

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #11 on: March 22, 2013, 11:31:41 am »
Hello Larry,

I'm adjusting the code somewhat for the rexx openweather script, but am not finished yet.

Do you need to fetch alot of data since you consider curl?
If not, create your own script and set defaults¹, copy some of the functions² in this script and use³ them.

¹) Code skeleton for a FAKE URL, replace with an actual working URL to make this work.
Code: [Select]
/* MyScript.cmd - Begin with the comment that identifies it as a rexx script */

/*Load the Libraries you need */
/* Initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
   rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
   rc = SockLoadFuncs()
end

/* Place your preparation code here ===START=== */
system_language = VALUE( 'LANGUAGE',, 'OS2ENVIRONMENT' )
target_language = 'EN' /* Translate from English to */
retrieve_this_url = 'http://translate.google.com/...?from_lang='||system_language||'&to_lang='||target_language||'&text='||ARG(1)
/* Place your preparation code here ===END=== */

CALL rxURLComponents 'stemname.', 
CALL rxURLConnect()
IF rxURLRetrieve() < 0 THEN
DO
   SAY 'A problem occurred!'
   RETURN 1
END
/* Place code here to use/interpret the received data ===START=== */
SAY text
/*stem = 'myjson.'
 IF fromJSon( text ) = 0 THEN
DO i = 1 TO myjson.0
   SAY VALUE( myjson.i )
END*/
CALL CHAROUT 'output.txt', text
/* Place code here to use/interpret the received data ===END=== */

RETURN 0

/* Add copied functions, see ² below */

²) Useful functions
rxURLConnect - Establish the initial connection with the server
rxURLRetrieve - Fetch data from the net
rxURLComponents - Place split up URL into an array (called stem in rexx) for rxURLConnect to use
GetURLComponents - Does the actual split into manageable pieces as separate variables

In what format do you get the reply?
fromJSon  - Interpret the JSon format and place the data in a stem
parse_xml_tags - Interpret the XML/HTML format, and extract individual tags, just ask and I'll post one I've written
   
CHANGESTR - My own useful function to replace a string with another, available in ORexx, but not in Classic Rexx

³) Start a command line and test the code
[c:\temp]myscript This is a text in English to translate into my own language

//Jan-Erik

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #12 on: October 24, 2013, 11:54:25 am »
Adjusted the function "parse_xml_tags" to handle a case when similar tag names where used.

Code: [Select]
parse_xml_tags: PROCEDURE /* xmlString, tag <<, tag_value>, selection> */
    prev_trace = TRACE( 'O' )
    PARSE UPPER ARG xmlString, tag, val, selection
    start_tag = '<'||tag
    INTERPRET "PARSE VALUE xmlString WITH pre'"||start_tag||val||"'extra'>'post"
    SELECT
        WHEN selection = 1 THEN /* tag */
        DO
            IF LENGTH( extra ) > 0 THEN
            DO
                PARSE VALUE SUBSTR( ARG(1), ABS( LENGTH( xmlString ) - LENGTH( post ) + 1 ) ) WITH pre'<'.
                RETURN pre
            END
        END
        WHEN selection = 2 THEN /* tag value */
            RETURN SUBSTR( ARG(1), ABS( LENGTH( xmlString ) - LENGTH( post ) - LENGTH( extra ) ), LENGTH( extra ) - ( RIGHT( extra, 1 ) = '/' ) )
        WHEN RIGHT( extra, 1 ) <> '/' THEN
        DO
            end_tag = '</'||tag||'>'
            next = LENGTH( xmlString ) - LENGTH( post ) + 1
            open_tag = next
            INTERPRET "PARSE VALUE post WITH pre'"||end_tag||"'post"
            close_tag = LENGTH( xmlString ) - LENGTH( post ) - LENGTH( end_tag ) + 1
            count = COUNTSTR( start_tag||'>', xmlString, open_tag, close_tag ) + COUNTSTR( start_tag||' ', xmlString, open_tag, close_tag )
            DO WHILE count > 0
                next = close_tag + LENGTH( end_tag )
                close_tag = POS( end_tag, xmlString, next )
                IF close_tag = 0 THEN
                    close_tag = LENGTH( xmlString )
                post = SUBSTR( xmlString, next, close_tag - next )
               
                INTERPRET "PARSE VALUE post WITH .'"||start_tag||"'extra'/>'post"
               
                DO WHILE LENGTH( post ) > 0
                    next = close_tag - LENGTH( post )
                    INTERPRET "PARSE VALUE post WITH .'"||start_tag||"'extra'/>'post"
                END
                count = COUNTSTR( start_tag||'>', xmlString, open_tag, close_tag ) + COUNTSTR( start_tag||' ', xmlString, open_tag, close_tag ) - 1
            END
            IF close_tag = 0 THEN close_tag = LENGTH( ARG(1) ) - open_tag
            ELSE close_tag = close_tag - open_tag
            RETURN SUBSTR( ARG(1), open_tag, MAX( 1, close_tag ) )
        END
        OTHERWISE NOP
    END
    CALL TRACE prev_trace
RETURN ''
   
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
    IF ARG() < 2 THEN RETURN -1
    IF DATATYPE( ARG(3), 'W' ) THEN
        next = ARG(3)
    ELSE
        next = 1
    needle = ARG(1)
    haystack = ARG(2)
    IF DATATYPE( ARG(4), 'W' ) THEN
        haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
    next = 1
    count = 0
    DO WHILE next > 0
        next = POS( needle, haystack, next )
        IF next > 0 THEN DO
            next = next + LENGTH( needle )
            count = count + 1
        END
    END
RETURN count

//Jan-Erik

Fr4nk

  • Guest
Re: JSon to Rexx (stem)
« Reply #13 on: January 01, 2014, 05:24:23 pm »
Hello,

some years ago I made a Rexx-based WPS Gadget called WorkPlaceWeather. It creates a WPS Object with weather icon and informations as object text.

http://subsys.de/WPWeather/

I used wetter.com to get the weather informations and forecasts, and now I want to change to Open Weather Map.

So I just found your json parser and would be happy to use it to change my program. Thanks a lot this saved me some hours :) I'll come back when its done.
« Last Edit: January 08, 2014, 10:12:53 am by Fr4nk »

Jan-Erik Lärka

  • Global Moderator
  • Sr. Member
  • *****
  • Posts: 275
  • Karma: +5/-0
    • View Profile
Re: JSon to Rexx (stem)
« Reply #14 on: January 07, 2014, 10:44:02 am »
Hello,

That would be awsome Fr4nk, I want it!  :D

I've tested the parsing on various JSon files, but do tell me if you run into problems and want me to look into it!

The script should give you a general idea of how to do it and an XCenter Widget would be so nice to have!

You may have to improve checks within your script somewhat compared to this script to verify what gets returned as the openweather service (or is it the site http://geoip.prototypeapp.com) seem to not return the expected data during updates with the current code.

//Jan-Erik