OS2 World Community Forum
OS/2, eCS & ArcaOS - Technical => Programming => Topic started by: Jan-Erik Lärka 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.
/*
* 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 (http://openweathermap.org/wiki/API/JSON_API)
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
-
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
/*
* 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()
-
continued...
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 */
-
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.
-
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
-
Here it detects the right location, can't seem to post the ini file as attachment .
-
Great!
Thank you guzzi for the feedback!
Hope you all don't mind that it tries to do find the position automatically.
//Jan-Erik
-
//-----
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!
-
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
-
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...
-
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.
-
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.
/* 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
-
Adjusted the function "parse_xml_tags" to handle a case when similar tag names where used.
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
-
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/ (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.
-
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
-
Hiho,
well it is not a real XCenter Widget. I prefer to use vanilla wps-objects. But of course you might drop such an object on your x-center/warpcenter/bubblepad/whatever, get an icon and a fly-over forecast.
I'm not sure about IP localization, maybe we do it as an option - but also manually localization entries (of course). Btw a nice geo-localization service is http://en.utrace.de/api.php - they provide very simple requests and returns XML-based data to get latitude and longitude.
Hopefully I'll find free time for this next weekend.
cu shortly :)
Fr4nk
-
Ahh, I followed the link and like it alot! Really nice!
As a matter of fact, my initial post was aimed at you when I wrote it to use the openweather service. ;)
//Jan-Erik
Below I've added selection 3 and 4 to the xml-parser if someone would need it.
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 selection = 3 THEN /* tag value */
DO
tag_val = SUBSTR( ARG(1), ABS( LENGTH( xmlString ) - LENGTH( post ) - LENGTH( extra ) ), LENGTH( extra ) - ( RIGHT( extra, 1 ) = '/' ) )
INTERPRET "PARSE CASELESS VALUE tag_val WITH .'"||val||'="'||"'ret_val'"||'"'||"'."
IF LENGTH( ret_val ) > 0 THEN RETURN ret_val
INTERPRET "PARSE CASELESS VALUE tag_val WITH .'"||val||"='ret_val ."
IF LENGTH( ret_val ) > 0 THEN RETURN ret_val
ELSE RETURN tag_val /* What 2 do else?! */
END
WHEN selection = 4 THEN /* tag name value */
DO
INTERPRET "PARSE VALUE xmlString WITH pre'"||start_tag||" NAME="||'"'||STRIP( val,, '"' )||'"'||" VALUE="||'"'||"'extra'"||'"'||" />'."
IF LENGTH( STRIP( extra ) ) = 0 THEN
INTERPRET "PARSE VALUE xmlString WITH pre'"||start_tag||" NAME="||STRIP( val,, '"' )||" VALUE="||"'extra'"||"/'."
IF LENGTH( STRIP( extra ) ) = 0 THEN RETURN ''
start_pos = POS( extra, TRANSLATE( xmlString ) )
IF start_pos > 0 THEN RETURN SUBSTR( ARG(1), start_pos, LENGTH( extra ) )
ELSE RETURN ''
END
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 ''
I've tested this code with regina that is somewhat limited when it come to PARSE, so you can try to replace:
INTERPRET "PARSE VALUE xmlString WITH pre'"||start_tag||" NAME="||'"'||STRIP( val,, '"' )||'"'||" VALUE="||'"'||"'extra'"||'"'||" />'."
with
val = STRIP( val,, '"' )
PARSE VALUE xmlString WITH pre(start_tag)' NAME="'(val)'" VALUE="'extra'" />'
-
Thank you - I'll check it out.
-
New and improved :)
Tested on json from https://glosbe.com/ as well as openweather.
/*
* Filename: fromJSon.cmd
* Author: JANERIK
* Created: Sat Feb 3 2018
* Purpose:
* 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'
!_arrays_! = 'json.'
DO WHILE 0 < RxFromJSon( f_input )
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
SAY 'Press <Enter> to show JSON as flat Stem'
PARSE PULL
DO i = 1 TO json.!.0
SAY json'.!.'i' -> 'json.!.i' => 'VALUE( json.!.i )
END
SAY 'Press <Enter> to show JSON Tree View Stem'
PARSE PULL
CALL RxRecursive 'json'
RETURN 0
RxRecursive: PROCEDURE EXPOSE (!_arrays_!) stem
stm = ARG(1)
DO i = 1 TO VALUE( stm'.0' )
IF SYMBOL( VALUE( stm'.i' ) ) = 'VAR' THEN
SAY stm'.'i' -> 'VALUE( stm'.i' )' => 'VALUE( VALUE( stm'.i' ) )
IF DATATYPE( VALUE( stm'.i.0' ), 'W' ) THEN
CALL RxRecursive stm'.'i
END
RETURN 0
RxFromJSon: PROCEDURE EXPOSE (!_arrays_!) stem
IF SYMBOL( 'stem' ) = 'LIT' THEN
!_stem_! = 'json'
ELSE
!_stem_! = STRIP( stem, 'T', '.' )
IF SYMBOL( '!_arrays_!' ) = 'LIT' THEN
!_arrays_! = !_stem_!'.'
!_json_! = !_stem_!
!_tree_! = !_stem_!
!_str_! = STRIP( ARG(1) )
!_delim_! = ',:'
!_quote_! = '""""'||"''''"
!_group_! = '[]{}'
!__tag__! = !_quote_!||!_group_!||!_delim_!
!_counter_! = 0
DO FOREVER
old_trace = TRACE( 'O' )
!_next_! = 1
!_stop_! = LENGTH( !_str_! )
DO !_i_! = 1 TO LENGTH( !__tag__! )
!_char_! = SUBSTR( !__tag__!, !_i_!, 1 )
!_pos_!.!_i_! = POS( !_char_!, !_str_! )
IF 8 < !_i_! THEN
DO
DO !_j_! = 1 TO 7 BY 2
!_k_! = !_j_! + 1
IF RxIsBetween( !_pos_!.!_j_!, !_pos_!.!_i_!, !_pos_!.!_k_! ) THEN
!_pos_!.!_i_! = POS( !_char_!, !_str_!, !_pos_!.!_k_! + 1 )
END
END
ELSE
!_pos_!.!_i_! = POS( !_char_!, !_str_!, !_next_! )
IF !_i_! < 9 & 0 < !_pos_!.!_i_! THEN
DO
IF !_i_! % 2 = 0 THEN
!_stop_! = MIN( !_stop_!, !_pos_!.!_i_! + 1 )
!_next_! = !_pos_!.!_i_! + 1
END
ELSE !_next_! = 1
!_sorted_!.!_i_! = !_pos_!.!_i_! !_char_!
END
DO !_i_! = 1 TO LENGTH( !__tag__! )
DO !_j_! = !_i_! + 1 TO LENGTH( !__tag__! )
IF SUBWORD( !_sorted_!.!_j_!, 1, 1 ) < SUBWORD( !_sorted_!.!_i_!, 1, 1 ) & 0 < SUBWORD( !_sorted_!.!_j_!, 1, 1 ) | 0 = SUBWORD( !_sorted_!.!_i_!, 1, 1 ) THEN
DO
!_temp_! = !_sorted_!.!_i_!
!_sorted_!.!_i_! = !_sorted_!.!_j_!
!_sorted_!.!_j_! = !_temp_!
END
END
!_ord_!.!_i_! = SUBWORD( !_sorted_!.!_i_!, 1, 1 )
IF 0 < !_ord_!.!_i_! THEN
!_chr_!.!_i_! = SUBWORD( !_sorted_!.!_i_!, 2, 1 )
ELSE
!_chr_!.!_i_! = ''
END
!_i_! = 2
CALL TRACE old_trace
IF 0 < POS( !_chr_!.1, ',}]' ) THEN
DO
!_lpos_! = LASTPOS( '.', !_json_! ) - 1
IF 0 < !_lpos_! THEN
!_json_! = LEFT( !_json_!, !_lpos_! )
!_lpos_! = LASTPOS( '.', !_tree_! ) - 1
IF 0 < !_lpos_! THEN
!_tree_! = LEFT( !_tree_!, !_lpos_! )
END
ELSE IF !_chr_!.3 = ':' THEN
DO
DROP result
!_key_! = SUBSTR( !_str_!, !_ord_!.1 + LENGTH( !_chr_!.1 ), !_ord_!.2 + LENGTH( !_chr_!.2 ) - !_ord_!.1 - LENGTH( !_chr_!.1 ) - 1 )
!_num_! = 3 + ( 0 < POS( !_chr_!.4, !_quote_! ) | SUBSTR( !_group_!, POS( !_chr_!.4, !_group_! ) + 1, 1 ) = !_chr_!.5 )
!_num_2_! = !_num_! + 1
!_val_! = STRIP( SUBSTR( !_str_!, !_ord_!.!_num_! + LENGTH( !_chr_!.!_num_! ), !_ord_!.!_num_2_! + LENGTH( !_chr_!.!_num_2_! ) - !_ord_!.!_num_! - LENGTH( !_chr_!.!_num_! ) - 1 ) )
!_json_! = !_json_!'.'!_key_!
IF 0 < LENGTH( !_val_! ) | 0 < POS( !_chr_!.4, !_quote_! ) THEN
DO
INTERPRET !_json_!' = "'!_val_!'"'
!_counter_! = !_counter_! + 1
CALL VALUE !_stem_!'.!.'!_counter_!, !_json_!
CALL VALUE !_stem_!'.!.0', !_counter_!
!_val_! = VALUE( !_tree_!'.0' )
IF \DATATYPE( !_val_!, 'W' ) THEN
!_val_! = 0
!_val_! = !_val_! + 1
CALL VALUE !_tree_!'.0', !_val_!
!_tree_! = !_tree_!'.'!_val_!
CALL VALUE !_tree_!, !_json_!
END
!_i_! = !_num_! + 1 + ( 0 < POS( !_chr_!.4, !_quote_! ) | SUBSTR( !_group_!, POS( !_chr_!.4, !_group_! ) + 1, 1 ) = !_chr_!.5 )
END
ELSE IF 0 < POS( !_chr_!.1, '{[' ) THEN
DO
IF !_chr_!.1 = '[' THEN
!_val_! = 0
ELSE
!_val_! = VALUE( !_json_!'.0' )
IF DATATYPE( !_val_!, 'W' ) THEN
DO
!_val_! = !_val_! + 1
CALL VALUE !_json_!'.0', !_val_!
!_json_! = !_json_!'.'!_val_!
CALL VALUE !_tree_!'.0', !_val_!
!_tree_! = !_tree_!'.'!_val_!
CALL VALUE !_tree_!, !_json_!
END
END
IF 0 < !_ord_!.!_i_! THEN
!_str_! = SUBSTR( !_str_!, !_ord_!.!_i_! )
ELSE LEAVE
END
RETURN 0 < POS( '.', !_tree_! )
RxIsBetween: PROCEDURE
RETURN ARG(1) < ARG(2) & ARG(2) < ARG(3)
-
I'm waking this thread up after a long time. I started to write a REXX program to control the GL.iNet family of routers. These tiny routers can provide wireless support. But the user interface does not work with Firefox 45.
So I use curl and an API to control the router. So far, I can go to some WiFi hotspots, connect to them and surf the internet.
In order to do this, I needed to interpret the JSON file that CURL returns. So here I am. I used this:
* Filename: JSon2Rx.cmd
* Author: Jan-Erik
* Created: Sat Feb 23 2013
* Purpose: Interpret a JSon-file and place in stem
I found it had a problem with one of the files I got. So I tried this one:
/*
* Filename: fromJSon.cmd
* Author: JANERIK
* Created: Sat Feb 3 2018
Amazingly, this hangs my ArcaOS computer. I type
fromJSon curldns.txt
and it never completes. Is there something wrong with my computer, or is fromJSon.cmd doing something wierd?
-
I'm waking this thread up after a long time. I started to write a REXX program to control the GL.iNet family of routers. These tiny routers can provide wireless support. But the user interface does not work with Firefox 45.
So I use curl and an API to control the router. So far, I can go to some WiFi hotspots, connect to them and surf the internet.
In order to do this, I needed to interpret the JSON file that CURL returns. So here I am. I used this:
* Filename: JSon2Rx.cmd
* Author: Jan-Erik
* Created: Sat Feb 23 2013
* Purpose: Interpret a JSon-file and place in stem
I found it had a problem with one of the files I got. So I tried this one:
/*
* Filename: fromJSon.cmd
* Author: JANERIK
* Created: Sat Feb 3 2018
Amazingly, this hangs my ArcaOS computer. I type
fromJSon curldns.txt
and it never completes. Is there something wrong with my computer, or is fromJSon.cmd doing something wierd?
First question: did you try to validate the json file?
A REXX script should not be able to hang OS/2, but I'm afraid this may happen.
Mentore
-
What does "it never completes" actually mean? Does it even prevent you from doing a Ctrl-C?
The script contains a recursive function. In case of programming error, it could loop forever and also use up all of the stack. But of course, you should still be able to do a Ctrl-C.
-
If I catch it in time, I can ctrl-C to stop it. Otherwise only the power switch.
There are C language JSON interpreters, but it was so nice to have the REXX one.
The website at https://jsonformatter.curiousconcept.com/ (https://jsonformatter.curiousconcept.com/) says the file is valid JSON, and it shows that the file is really not that complex. There are just 11 items, one of which is an array.
-
Maybe the easiest thing would be to wrap the C code with the REXX Interface. That will give you a good performance and still allow you to use it from REXX. But of course, you'll either need the C Source or a DLL to link to (with a published interface).
-
If I catch it in time, I can ctrl-C to stop it. Otherwise only the power switch.
There are C language JSON interpreters, but it was so nice to have the REXX one.
The website at https://jsonformatter.curiousconcept.com/ (https://jsonformatter.curiousconcept.com/) says the file is valid JSON, and it shows that the file is really not that complex. There are just 11 items, one of which is an array.
I take it, the recursion never stops and eventually blows the stack. And then there seems to be a bug in the REXX interpreter to hang the whole system.
-
Hello,
I used:
set rextrace=on
and stepped thorugh the code...
It parse almost all of the file, but it stumble on the last
"code":0}
and never complete as it can't handle that last section.
The result is that the code skip past and return the same text over and over again in rapid succession, thus eventually look up the computer.
The short term solution would be just to remove what's left, but I'll look into it somewhat to see what I can do about it.
Recursion:
Problems usually result in that the interpreter exit abnormally with a message that contain a call to the same function, though visually offset from the previous. Rexx can not handle that many levels of recursion s0 it's possible to write code that can parse an advanced file. One has to handle such solutions with queues or stacks.
call bla( param_1, param_n )
call bla( param_1, param_n )
call bla( param_1, param_n )
call bla( param_1, param_n )
call bla( param_1, param_n )
call bla( param_1, param_n )
call bla( param_1, param_n )
call bla( param_1, param_n )
-
Ok,
3 issues:
1. The code need that a json file begin with "[{" and end with "}]"
It can be easily be resolved with
IF LEFT( !_str_!, 1 ) = '{' THEN
!_str_! = '['||!_str_!||']'
right after
!_str_! = STRIP( ARG(1) )
2. The mentioned ending of the file has to be coded into the part that handle ':'
Tested here and done.
3. The code focus on key'='value (including such lists) and not on value lists only.
An additional section has to be added that take care of the list
"proxy_serverlist":[...]